1 line
13 KiB
Plaintext
1 line
13 KiB
Plaintext
\ Grafik Demo UH 03Dec86Dieses File enthaelt im Wesentlichen die Definitionen der Grafikdemo vom C64 und vom Atari. Start mit INCLUDE GRAFDEMO.SCR An diesem Beispiel zeigt sich, dass sich mit volksFORTH relativ leicht Programme von einem auf den anderen Rechner uebertragen lassen, auch wenn die Basis (hier das Grafik-Paket) unterschied-lich ist. Natuerlich muss auf spezielle Eigenschaften des LINE-A-Grafic Pakets des Atari verzichtet werden. (z.B. gestrichelte Linien zeichen) Ist die Basis dagegen gleich, wie z.B der Kern aller volksFORTH Systeme, ist eine Uebernahme von Programmen gar kein Problem mehr. \ Demo Loadscreen 05Sep86 \needs Graphics include grafik.scr Onlyforth Graphics also definitions \needs exorwrite include atari.scr \ Atari Grafic-Name Layer \needs 2over include double.scr 1 $0A +thru \ clear moire \ muster kaleidos boxes \ poly lines \ tri.up tri.dn 25feb86 | : yscale [ decimal ] 400 640 */ [ hex ] ; : tri.dn ( dim -- ) >r cur.x @ cur.y @ 2dup r@ yscale - swap r@ - swap 2swap 2over set 2dup r@ yscale - swap r@ + swap draw 2dup r> yscale + draw 2swap draw set ; : tri.up ( dim -- ) >r cur.x @ cur.y @ 2dup r@ yscale - 2swap 2over set 2dup r@ yscale + swap r@ + swap draw 2dup r@ yscale + swap r> - swap draw 2swap draw set ; \ diamond UH 05Sep86 : diamond ( size -- ) >r cur.x @ cur.y @ 2dup swap r@ - swap 2swap 2over set 2dup r@ yscale - draw 2dup swap r@ + swap draw 2dup r> yscale + draw 2swap draw set ; | : big.diamond exorwrite &319 0 &639 &200 &319 &399 0 &200 4 polygon ; \ some usefull definitions 05Sep86 | : center &320 &200 set ; \ | : wrap #esc con! Ascii v con! ; wrap | : logo &117 0 DO ." volksFORTH 83 " LOOP ; | : wait BEGIN pause key? UNTIL &25 0 at getkey #cr = abort" stopped" ; | : titel &21 &24 at ." *** v o l k s F O R T H *** " &22 &31 at ." Line-A Graphic " ; \ patterns example 04Sep86\\ : muster page overwrite 1 pat.mask ! $10 0 DO patterns I 2* + @ pattern ! $10 I $10 * + dup $80 $80 rectangle LOOP 6 pat.mask ! $10 0 DO patterns I 2* + @ pattern ! $110 I $10 * dup >r + $110 r> - $80 $80 rectangle LOOP 1 pat.mask ! wait ; \ kaleidoskop UH 05Sep86 | : kaleid exorwrite home center \ patterns &30 + @ pattern ! 2 0 DO $40 1 DO $140 0 DO I diamond J 2* +LOOP 2 +LOOP LOOP ; : kaleidos page big.diamond kaleid wait ; : kaleid1 page logo kaleid wait ; : diamonds $10 0 DO \ patterns I 2* + @ pattern ! page big.diamond wait LOOP ; \ polygon example 05Sep86 | : (poly ( x y -- ) 2dup >r &100 + r> &10 + 2dup >r &10 + r> &90 + 2dup >r &30 - r> &20 + 2dup >r &50 - r> &35 - 2dup >r &30 - r> &85 - 6 polygon ; \\ : poly page invtrans &10 0 DO patterns I 5 + 2* + @ pattern ! I I * &5 * I &30 * (poly LOOP &10 0 DO patterns I 5 + 2* + @ pattern ! &510 I I * &5 * - I &30 * (poly LOOP wait ; \ moire 27feb86 : moire page curoff exorwrite &640 0 DO I &399 &639 I - 0 line 3 +loop &399 0 DO &639 &398 I - 0 I line 2 +loop titel wait ; \ boxes 05Sep86 : boxes page &162 0 DO I I set I I box &639 I 2* - I set I I box I &399 I 2* - set I I box &639 I 2* - &399 I 2* - set I I box 2 +LOOP wait ; \ linien 27feb86 | : (lines ( abstand -- ) exorwrite &640 0 DO &640 0 DO I &399 J 0 line dup +LOOP dup +LOOP drop ; : lines page home curoff &45 (lines &90 (lines BEGIN &45 (lines key $FF and $0D = UNTIL &25 0 at ; \ moire punkte muster 05Sep86 : kreis.moire page &320 0 DO &199 0 DO I dup * J dup * + &300 / 1 and IF &320 J + &200 I + 1 put.pixel &320 J - &200 I + 1 put.pixel &320 J - &200 I - 1 put.pixel &320 J + &200 I - 1 put.pixel THEN 2 +LOOP LOOP wait ; |