VolksForth/8080/AmstradCPC/GRAFIK.SCR

1 line
16 KiB
Plaintext

\ Grafik UH 03Dec86 Diese File enthaelt Definitionen, die die von der Firmware der AMSTRAD-ROMS vorgegebenen Grafikmoeglichkeiten zur Verfuegung stellt. Die Namen der Worte sind an die im Schneider-Handbuch angege- benen Bezeichnungen angelehnt. Da je nach Systemkonfiguration die Schnittstelle zur Firmware anders aussieht, muss der entsprechende Systemteil geladen werden. Dies geschieht durch auskommentieren auf dem LOAD- Screen (Screen 1 von GRAFIK.SCR). Zur Zeit sind zwei Systemkonfigurationen unterstuetzt: 1) Standard 3" Laufwerk mit 38K-CP/M 2) Vortex-X Laufwerk mit 62K-CP/M Sie koennen als Beispiel fuer andere Systemteile dienen. \ Line Graphics Loadscreen UH 03Dec86 Onlyforth include vdos62kx.scr \ Vortex X-Laufwerk 62K-CP/M \ include amsdos.scr \ original Schneider 3" (Amsdos) 38K-CP/M 1 $08 +thru Onlyforth \ Calling ROM UH 29Nov86 Onlyforth Assembler also definitions Create rom IP push jumprom call IP pop ret end-code : getstart ( -- ) W inx xchg M E mov H inx M D mov xchg 'start shld ; \ Calling Operating-System UH 29Nov86Onlyforth Vocabulary OS Assembler also OS also definitions : Sys ( addr -- ) +org Constant ;code ( -- ) getstart rom call Next end-code : >Sys ( addr -- ) Sys ;code ( n -- ) getstart H pop L A mov rom call Next end-code : Sys> ( addr -- ) Sys ;code ( -- n ) getstart rom call A L mov 0 H mvi Hpush jmp end-code : >>Sys> ( addr -- ) Sys ;code ( x y -- n ) getstart H pop D pop rom call A L mov 0 H mvi Hpush jmp end-code \ Calling Operating-System UH 29Nov86 : >>Sys ( addr - ) Sys ;code ( x y -- ) getstart H pop D pop rom call Next end-code : Sys>> ( addr - ) Sys ;code ( -- x y ) getstart rom call dpush jmp end-code \ Graphic-calls UH 29Nov86Onlyforth Vocabulary Graphics OS also Graphics also definitions $BBBA Sys init $BBBD Sys reset $BBC0 >>Sys move $BBC3 >>Sys mover $BBC6 Sys>> cursor@ $BBC9 >>Sys origin $BBCC Sys>> origin@ $BBCF >>Sys width $BBD2 >>Sys heigth $BBD5 Sys>> width@ $BBD8 Sys>> heigth@ $BBDB Sys clearwindow $BBDE >Sys pen $BBE1 Sys> pen@ $BBE4 >Sys paper $BBE7 Sys> paper@ $BBEA >>Sys plot $BBED >>Sys plotr $BBF0 >>Sys> test $BBF3 >>Sys> testr $BBF6 >>Sys line $BBF9 >>Sys liner $BC59 >Sys access \ Farbwahl Graphic UH 29Nov86 Code (ink ( col1 col2 pen -- ) $BC32 +org H lxi 'start shld H pop L A mov H pop D pop IP push L B mov E C mov jumprom call IP pop Next end-code : ink ( colour -- ) dup pen@ (ink ; Code (ink@ ( pen -- col1 col2 ) $BC35 +org H lxi 'start shld H pop L A mov IP push jumprom call D pop 0 H mvi B L mov H push C L mov D IP mvx Hpush jmp end-code : ink@ ( -- col ) pen@ (ink@ drop ; \ Randfarben UH 29Nov86 Code border ( colour -- ) $BC38 +org H lxi 'start shld H pop IP push L B mov L C mov jumprom call IP pop Next end-code Code border@ ( -- colour ) $BC3B +org H lxi 'start shld IP push jumprom call 0 H mvi C L mov IP pop Hpush jmp end-code \ Schneider Farben 05Sep86\\ 0 Constant schwarz &13 Constant weiss 1 Constant blau &14 Constant pastellblau 2 Constant hellblau &15 Constant orange 3 Constant rot &16 Constant rosa 4 Constant magenta &17 Constant pastellmagenta 5 Constant hellviolett &18 Constant hellgruen 6 Constant hellrot &19 Constant seegruen 7 Constant purpur &20 Constant hellesblaugruen 8 Constant hellmagenta &21 Constant limonengruen 9 Constant gruen &22 Constant pastellgruen &10 Constant blaugruen &23 Constant pastellblaugruen &11 Constant himmelblau &24 Constant hellgelb &12 Constant gelb &25 Constant pastellgelb &26 Constant leuchtendweiss \ polygon box rectangle UH 29Nov86 : polygon ( x1 y1 x2 y2 ... xn yn n -- ) -rot 2dup >r >r move 1 DO line LOOP r> r> line ; : box ( width heigth -- ) 0 over liner over 0 liner 0 swap negate liner negate 0 liner ; : rectangle ( x1 y1 width heigth -- ) 2swap move box ;