VolksForth/8080/AmstradCPC/GRAFIK.SCR

\ 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 ;