Turbo Toolbox

home *** CD-ROM | disk | FTP | other *** search

/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 09_10 / gfademo / bigdemo.gfa (.txt) next >

Wrap

GFA-BASIC MS-DOS | 1991-07-10 | 75.2 KB | 2,071 lines

GFA-BASIC MS-DOS Limit xcmin dmin_ dmax_ stpx_ stpy_ -1+0.99/ 0.99/ lofm1_ tabp_ tabw_ tabm_ fcol_ win1_ win_2 win2_ entry start_ xoff_ yoff_ DCLURE LOCAL NOSOURCEW NOW4,1 window coloM =_Y/4* wahl_fine global variablest '%JNG Xcrossx_ INDEX PPOSEDURE SLIDER PINDEX PENTRY SOURCE SNAMEobal arrays windows which SetSystemColors GetWordList DefineGlobalVariables DefineGlobalArrays CreateMenuBar GetPopupPos DefineProgramVariables ConfigGlobalArrays DefineProgramArrays EvaluateMessage OpenDesktop GetSource PrepareSource PresentSource WindCreate GetSliderMetrics MinimizeWindow Redrawxywh MaximizeWindow RestoreWindow KonfigWin EvaluateKey SliderEvent AliasMenu EvaluateMenu Redraw NoWindow GetWinCoord Moire Pulse Circles Magic1 Rings GetPicture Mirror Magnify Project Stretch Mandelbrot Betelguese AdjustRect Lissajous Turtle1 Circle Turtle2 Totem AdjustRect1 SineEx K1ff EntryList MenuEntry PopupEntry WindowTitel WindowAttributes COLOR InfoMessage pup-menusSTDT Das Demoprogramm l uft nur|auf EGA, VGA oder | Herkules KartenZ RETURNH _ADAP 3~INTR($10,_AX=$1A00)IF _AL=$1a 640*480ELSE 640*350ENDIF _ADAP ModeELSEALERT 1,"Das Demoprogramm nur|auf Herkules Karten",1,"RETURN", SYSTEMENDIF SCREEN Systemcolor menu-bar, windows,... program global variables graphic interface global arrays graphic interface create menu-bar position popup-menu entries global variables program assigns values arrays graphic interface global arrays program Message evaluation _ADAP 3SCREEN 3ELSESCREEN 7ENDIF PROCEDURE define system colors brush SYSCOL 0,14,1 color menu-barSYSCOL 1,14,1 color menus SYSCOL 2,1,14 color popup-menus SYSCOL 3,8,7 color window framesSYSCOL 4,15,0 color effectsSYSCOL 5,15,7 color inside window framesSYSCOL 6,8,8 desktop color (window 0)SYSCOL 7,8,8 desktop brush SYSCOL 8,14,1 color ALERT boxes RETURN PROCEDURE desktop OPENW desktopCLEARW paint desktopWINDGET desktop coordinatesRETURN Lissajous Turtles Else m PROCEDURE define global variables number windows messages messages arrow up/down windows which contain exclusively up/down windows which contain exclusively arrow left/right windows which' contain exclusively left/right windows which' contain exclusively WINDGET height width popup-menus popup entries Lissajous Turtles ALIAS-menu-barRETURN PROCEDURE define global arrays window position extension window titelDIM slider position extension window attributes index window content 'window opened' flags 'window slider' flags 'window window' flagsDIM 'window iconized' flags 'window popup-menu' flags array menu-entriesDIM letters inside window strings window string length X-offset inside windowDIM Y-offset inside windowDIM positions popup menusDIM entries popup RETURN PROCEDURE create menu-barLOCAL RESTORE entries UNTIL )="*/" /* entries RESTORE popup menus PENTRY$() UNTIL )="*/" create menu-bar desktop RETURN PROCEDURE position popup-menusLOCAL MID$( ,1)<>" -1WHILE MID$( ++WEND ENDIF UNTIL =>LEN( RETURN PROCEDURE define program variables windows opened windows window width icon) window height icon) index top-window =FALSE 'window maximized' flagRETURN PROCEDURE assign values global arrays LOCAL RESTORE window titlesNEXT RESTORE window attributes v-slider position h-slider position ,3)=( window width ,4)=( window heightNEXT (1,1)= initial positions windows (1,2)= (2,1)= (1,3) (2,2)= (3,1)= (3,2)= (1,4) (4,1)= (1,3) (4,2)= (1,4) /*RETURN PROCEDURE define program arrays picture Index windows (3,1000) array ASCII array ASCII RETURN *.LSTK ReturnH PROCEDURE ASCII Source LOCAL =PRED( LOCAL Tab-width (must (must tabw_%-1) begin coloumn count Tab)SYSCOL 3,14,8 color window frameSYSCOL 5,14,4 color inside frames SYSCOL 4,7,0 color effects FILESELECT "*.LST","", (LEN( (RIGHT$( )<>"\") "i",#1, =LOF(#1)-1 Handling Old-Style UNTIL LOC(#1)>= INPUT WHILE INSTR( ,CHR$(9)) Converts Spaces =INSTR( ,CHR$(9)) =LEFT$( -1)+SPACE$( ))+MID$( +1)WENDIF LEFT$( )=">" =MID$( ,3)IF LEN(TRIM$( STR$(i_%,4)+ ENDIF =1000LOOPCLOSE =FALSE ELSEALERT ,1,"Return", =TRUEENDIF RETURN PROCEDURE )LOCAL =PRED( )=LEN( ,1))FOR )=MAX( ),LEN( )))NEXT RETURN PROCEDURE )LOCAL =PRED( LOCAL )COLOR 14,8FOR 1,SPACE$( )ELSE MID$( )TEXT SPACE$( )ENDIF RETURN PROCEDURE window LOCAL ,1)&~7)+6 X-position window Y-position window width height )TITLEW window titelOPENW create window )=TRUE store window opened )ENDIF RETURN PROCEDURE iconize windowLOCAL LOCAL WINDGET store actual X-position window WINDGET store actual Y-position window WINDGET store actual width windowWINDGET store actual height window WINDGET outer window extension CLOSEW close window OPENW window )=TRUE store window iconized WINDGET outer extension position window inside screen iconized window covered another oneKILLEVENT message CLOSEW redraw covered windowELSE iconized window coveringKILLEVENT message CLOSEW redraw ENDIF ENDIF RETURN PROCEDURE maximize window window already maximzed restore former window extensions =FALSE clear 'window maximized' flagELSE window maximizedWINDGET store X-position windowWINDGET store Y-position windowWINDGET store window widthWINDGET store window height FULLW maximize window =TRUE store window maximized )ENDIF KILLEVENT FULLW message redraw desktop ENDIF RETURN PROCEDURE restore window former extensionLOCAL LOCAL WINDGET outer window extension CLOSEW close window window former extension WINDGET window extension window iconized )=FALSE clear 'window icon' flagENDIF position window inside screen window covered another KILLEVENT message CLOSEW redraw window covered windowELSE window covering KILLEVENT message CLOSEW redraw window ENDIF ENDIF RETURN PROCEDURE slider position extension WINDGET inner window extension pixel coloumns inside window inside windowWINDSET 8,SCALE( ,1),1000, v-slider WINDSET 10,SCALE( ,2),1000, h-sliderWINDSET 9,SCALE( )-1,1000,MAX( v-slider extension WINDSET 11,SCALE( )-1,1000,MAX( h-slider extensionRETURN PROCEDURE configurate window index window content )=FALSE window sliders )=FALSE windowIF window popup window attriubutes slider window without popup )=271 window attriubutes slider, info-bar ENDIF window title "+LEFT$( ,INSTR( ,"_")-1)+MID$( ,INSTR( ,"_")+1)+" create window configurated RETURN PROCEDURE message evaluation begin message evaluation WHILE LEN(INKEY$) until button downWENDGET_EVENT message =MENU(1) message =MENU(0) message message WINDGET index window SWITCH begin switch keyboard message evaluate keyboard message mousesclick outside windowIF MENU(7) mouseclick inside active window =MENU(7) index windowIF window iconized restore window former coordinatesELSE window iconized window ENDIF /*ENDIF /*CASE mouseclick inside windowIF window iconized restore window former coordinatesENDIF /*CASE closer messageCLOSEW close window )=FALSE store window closed )=FALSE clear slider )=FALSE clear window popup flagIF clear window content index ENDIF /*CASE iconizer messageIF window popup iconize windowENDIF /*CASE maximizer message maximize window window sliders slider metricsENDIF /*CASE 7,8,11,12,15 arrow/page up/down, vertical thumb window 9,10,13,14,16 arrow/page left/right, horizontal thumb window caption messageMOVEW ,(MENU(7)&~7)+6,MENU(8)/* window (MENU(7)&~7)+6 makes X-coord. dividable (faster !!)CASE sizer messageSIZEW ,MENU(7),MENU(8) window window sliders slider metricsENDIF /*CASE mouseclick inside info-bar window popup ,MENU(2),0) AliasMenu() ENDIF /*CASE menu-bar message evaluate messageCASE redraw message Redraw() ENDSWITCH switch message evaluation RETURN PROCEDURE evaluation menu-bar message LOCAL index window opened 'window open' FALSE means opened window found index window opened SWITCH switch menu-bar message Source GetSource() means source found PrepareSource() )=TRUE /* 'window slider' )=TRUE 'window window' )=256 window attributes info-bar) window content index window title create window ENDIF entry 'Graphics' (Moire) )CASE entry 'Graphics' (Pulse) )CASE entry 'Graphics' (Circles) )CASE entry 'Graphics' (Magic) )CASE entry 'Graphics' (Rings) )CASE (window popup menu) )=TRUE 'window popup menu' INFOW info-bar unique entry entry 'Text' (Mirror) )CASE entry 'Text' (Magnify) )CASE entry 'Text' (Project) entry 'Text' (Stretch) entry 'Text' (Turn) entry 'Special' (Mandelbrot) entry 'special' (Betelguese) ENDSWITCH window opened ALERT window opened' ENDIF RETURN PROCEDURE evaluation keyborad messageLOCAL =MENU(5), =MENU(5) index window opened 'window open' FALSENEXT means opened window found =$6B00 (Closer message) CLOSEW close window )=FALSE store window closed )=FALSE clear slider )=FALSE clear window popup flagIF clear window content index ENDIF /*ELSE window sliders (only windows) SWITCH switch messageCASE $4800 cursor ,7)CASE $4900 $5000 cursor ,8)CASE $5100 $4B00 cursor ,9)CASE $4700 $4D00 cursor right $4F00 $7300 cursor )CASE $7400 cursor right )ENDSWITCH window popup pressed ,0,1) AliasMenu() ENDIF ENDIF RETURN PROCEDURE Ctrl+ cursor left/right LOCAL WINDGET first windows SWITCH switch keyboard message $7400 cursor right windows displayed X-position window Y-position window ,3)=( width window height window ,1)=( X-position window Y-position window ,3)=( width window height windowCLOSEW close window CLOSEW close window KILLEVENT CLOSEW messages window windowELSE window displayed X-position window Y-position window ,3)=( width window height window CLOSEW close windowKILLEVENT CLOSEW messages window ENDIF $7300 cursor leftIF windows displayed X-position window Y-position window width window ,4)=( height window X-position window ,2)=( Y-position window width window ,4)=( height windowCLOSEW close window CLOSEW close window KILLEVENT CLOSEW messages window windowELSE window displayed X-position window Y-position window width window ,4)=( height window CLOSEW close windowKILLEVENT CLOSEW messages window ENDIF ENDSWITCH RETURN RETURNH PROCEDURE window availableLOCAL ALERT ,1,"RETURN", RETURN PROCEDURE window LOCAL actual v-slider position actual h-slider positionSWITCH switch slider message arrow decrease v-Slider positionCASE decrease v-Slider positionCASE arrow increase v-Slider positionCASE increase v-Slider positionCASE arrow decrease h-Slider positionCASE decrease h-Slider positionCASE arrow right increase h-Slider positionCASE right increase h-Slider positionCASE vertical thumb =SCALE(MENU(7),MAX(1, )+1),1000)CASE horizontal thumb =SCALE(MENU(7),MAX(1, )+1),1000)ENDSWITCH =MAX(MIN( )+1),0) calculate v-slider position =MAX(MIN( )+1),0) calculate h-slider positionIF v-slider position differs store v-slider position WINDSET 8,SCALE( ,1000,MAX(1, )+1)) v-slider position X-origin Y-origin display textENDIF h-slider position differs store h-slider position WINDSET 10,SCALE( ,1000,MAX(1, )+1)) h-slider position X-origin Y-origin display textENDIF /*RETURN PROCEDURE event related redraw PROCEDUREs Redraw() Redrawxywh() splitted force non-event related redraws. example: window going iconized yield redraw events: CLOSEW OPENW. window overlap another window redraw events. events killed KILLEVENT command non-event realted redraw forced calling/* Redrawxywh() given variables. Calling Redraw() always cause event related command. (MENU(7),MENU(8),MENU(9),MENU(10)) RETURN PROCEDURE forced redraw LOCAL LOCAL windows output window i_%WINDGET upper corner window i_%CLIP OFFSET upper cornerGETFIRST check first overlap/* window WHILE overlap RC_INTERSECT( overlapping rectangle obverlapping rectangle check window content inside overlapping rectangle SWITCH graphic routines redrawCASE )CASE (0,0)CASE )ELSE ,0,0)ENDIF ENDSWITCH ENDIF GETNEXT check overlap window WENDNEXT window output windowRETURN PROCEDURE needed Redraw WINDGET COLOR 15,15 0,0,9999,9999SWITCH (1,0,0)CASE (2,0,0)CASE (3,0,0)CASE (4,0,0)CASE ENDSWITCH RETURN PROCEDURE window popup menus LOCAL WINDGET inner window coordinates COLOR 15,15 0,0,9999,9999 adjust info-bar window adjust pixel letter-widthIF selection mouse-event selected popup start X-position X-positionIF mouse cursor inside determines selected /*ENDIF /*NEXT selection /*ENDIF popup foundREPEAT position popup andDEFFILL invert menuGRAPHMODE /*COLOR 15,15 X-start position selected invert =POPUP( check popupPBOX invertIF clipping SWITCH Lissajous SWITCH Figure 1,2,3,4 ,0,0)CASE Figure ENDSWITCH Turtles SWITCH Turtle Turtle ENDSWITCH ElseSWITCH Circles Lines ENDSWITCH ENDSWITCH =-1ELSESWITCH cursor rightIF selected increase menu. select first menuENDIF cursor selected (first menu), decrease #ELSE menu. select ENDIF DEFAULT Default selectionENDSWITCH ENDIF UNTIL clipping ENDIF RETURN PROCEDURE clipping backGRAPHMODE OFFSET Clipping cksetzenRETURN PROCEDURE clipping WINDGET GRAPHMODE OFFSET clipping backRETURN PROCEDURE )LOCAL COLOR 0,0,_X,_YGRAPHMODE COLOR 14FOR ,_X/2,_Y/2LINE ,_Y,_X/2,_Y/2 COLOR 11FOR ,_X/2,_Y/2LINE ,_X/2,_Y/2 GRAPHMODE RETURN ntPS' PROCEDURE LOCAL =_X/2, =_Y/2, COLOR 15PBOX 0,0,9999,9999GRAPHMODE COLOR =MAX(_X,_Y)FOR =PI/4 *COS( *SIN( *COS( *SIN( /.94NEXT GRAPHMODE RETURN PROCEDURE LOCAL COLOR 15,15 0,0,9999,9999DEFFILL SQR(SQR(2)) =MIN(_X/4,_Y/4) =_X/4* =_Y/4* =90/15* =359-270/15* COLOR CIRCLE ELLIPSE 2COLOR ,15PCIRCLE COLOR PELLIPSE DEFFILL RETURN PROCEDURE )LOCAL LOCAL LOCAL SWITCH 1COLOR 0,0,9999,9999COLOR _ADAP 1COLOR ENDIF =3CASE 2COLOR 0,0,9999,9999COLOR _ADAP 1COLOR ENDIF =2CASE 3COLOR 0,0,9999,9999COLOR =2CASE 4COLOR 0,0,9999,9999COLOR _ADAP 1COLOR ENDIF =4ENDSWITCH WINDGET WINDGET *(1+COSQ( *(1+SINQ( RETURN PROCEDURE LOCAL COLOR 0,0,9999,9999FOR )=SINQ( *131)*_X/3+_X/2 )=COSQ( *142)*_Y/3+_Y/2NEXT DEFLINE ,1RESTORE COLOR POLYLINE OFFSET SINQ( *10)*8,COSQ( *10)*8 ERASE RETURN rt 90 fd rt 90 fd rt 90 fd rt 90 bk rt 90 bk rt 90 bk rt 90 fd rt 90 fd rt 90 fd rt 90 bk rt 90 bk rt 90 bk PROCEDURE LOCAL =MIN(_X/2,_Y/2)COLOR 0,0,9999,9999GRAPHMODE 179COLOR RAND(_C)+1DRAW "ma",_X/2,_Y/2"tt", "fd", /4,"rt /4,"rt /4,"rt /4DRAW "bk", /2,"rt /2,"rt /2,"rt /2DRAW "fd", /4,"rt /4,"rt /4,"rt /4DRAW "bk", /2,"rt /2,"rt /2,"rt /2NEXT GRAPHMODE RETURN 333333 PROCEDURE LOCAL COLOR 0,0,9999,9999 =MIN(_X/2,_Y/2)DRAW "ma",_X/2- /1.7,_Y/2- /4"tt0"FOR "rt",8 "fd", /4,"rt",90,"fd", /4,"rt",90,"fd", /4,"rt",90,"fd", /4,"lt",270 "CO", COLOR RAND(_C)DRAW "rt",45-8,"pufd", /2,"pd"NEXT RETURN PROCEDURE LOCAL GRAPHMODE COLOR 0,0,9999,9999FOR 7DEFLINE COLOR =_X/3* _X/3*SUCC( )/7CIRCLE _X/2,_Y/2, DEFLINE RETURN PROCEDURE LOCAL )GRAPHMODE COLOR 15,15 0,0,9999,9999FOR DEFLINE ,RAND(20) 100COLOR RAND(_C)LINE RAND(_X),RAND(_Y),RAND(_X),RAND(_Y)NEXT DEFLINE ,1RETURN PROCEDURE LOCAL =_X/3, =PI/2 COLOR 0,0,9999,9999 RETURN PROCEDURE )LOCAL DEFFILL 16FOR 4+2*INT(_X/(_X+1)) =_X/12+ *3*_X/ *SINQ(DEG( =_Y/5*SIN( /DEG(2)) COLOR RAND(_C)+1PRBOX COLOR RAND(_C)+1RBOX DEFFILL RETURN 333333 333333 PROCEDURE LOCAL LOCAL LOCAL LOCAL =1.0E+20, LOCAL =_X/2, =_Y/2, LOCAL LOCAL LOCAL =1.2, LOCAL =2.5LOCAL LOCAL =16*PI/180, LOCAL LOCAL =SQR( ^2)LOCAL =0LOCAL LOCAL =SQR( =TAN( LOCAL =SQR( =TAN( )COLOR 0,0,9999,9999FOR REPEAT ENDIF SWITCH )CASE )ENDSWITCH UNTIL SWITCH 4PSET SUCC( ,5CONTCASE 3PSET ,SUCC( CONTCASE 2PSET SUCC( ),SUCC( ),4CONTCASE 1PSET ENDSWITCH ERASE RETURN PROCEDURE ENDIF RETURN PROCEDURE )LOCAL LOCAL (ABS( (ABS( =INT( *2)+INT( *2)+32 ENDIF =-1RETURN PROCEDURE )LOCAL LOCAL LOCAL -SQR( 0.001 ENDIF ENDIF RETURN PROCEDURE )LOCAL +=2RETURN PROCEDURE LOCAL LOCAL =_X/2, =_Y/2, =_X/36 LOCAL =2*PI, =3*PI, =_Y/20 COLOR 0,0,9999,9999FOR DOWNTO ^2FOR -_X/8 COLOR COLOR 14PLOT _X/4, COLOR COLOR ENDIF RETURN GFA-BASIC PROCEDURE LOCAL LOCAL COLOR 15,15 0,0,_X/2,_Y/2COLOR 14,4TEXT GFA-BASIC DEFFILL PELLIPSE /9COLOR /2-10, DEFFILL /2-3, /2-3COLOR GRAPHMODE -1FOR -1COLOR POINT( )PLOT DEFFILL COLOR 15RETURN PROCEDURE LOCAL LOCAL LOCAL LOCAL COLOR 0,0,9999,9999COLOR 14,13 DEFFILL 0,0,15,20TEXT 3,17,"?" -1+0.99/ 0.99/(2* +0.01FOR -1+0.99/ 0.99/ ,POINT( ENDIF DEFFILL RETURN BASIC*GFA- PROCEDURE LOCAL LOCAL =120/SINQ(45)/_X, =120/SINQ(45)/_Y LOCAL ="BASIC*GFA-"LOCAL =WIND_GET(14)+12 LOCAL =_Y/2, =_Y/2, =_X/2, =_Y/2 LOCAL =SIN(1), =COS(1) COLOR 0,0,9999,9999 =DEG(-1)WHILE <=DEG(1.35) 1COLOR 15,0PRINT AT(1,1);MID$( ,MID$( +4,1) 0.45/2/COSQ( 11.5/2/COSQ( PRED( PRED( =POINT( ,PRED( +1.14/2*( +1.14/2/COSQ( =SINQ( )*COSQ( =COSQ( )*COSQ( =SINQ( (_C-1) ENDIF ENDIF WENDRETURN Warum ist es am Rhein so sch PROCEDURE LOCAL LOCAL =WIND_GET(14), LOCAL Warum Rhein "LOCAL 1)LOCAL =_Y/20, DEFFILL COLOR PRBOX COLOR 14,1TEXT -1FOR -1COLOR POINT( SINQ( RETURN GFA-BASIC PROCEDURE LOCAL LOCAL =WIND_GET(14) LOCAL GFA-BASIC =(LEN( 3LOCAL 1)LOCAL LOCAL LOCAL 8LOCAL /4)LOCAL /4)LOCAL 0.99/( =0.99 LOCAL 0.99/( =0.99 COLOR 0,0,9999,9999COLOR 14,4TEXT SINQ( )*_X/2.1 COSQ( )*_Y/2.1 *SINQ( *COSQ( *COSQ( *SINQ( ))FOR POINT( *SINQ( *COSQ( *COSQ( *SINQ( ENDIF RETURN PROCEDURE LOCAL LOCAL LOCAL =-1000, =250, =625, =-625, =1000000WINDGET REPEAT PRED( WHILE ++WEND 15COLOR PRED( )LINE ,PRED( ELSEPSET ENDIF COLOR 15LINE ,PRED( ENDIF UNTIL =PRED( RETURN PROCEDURE LOCAL =-1.5, =-1.5, =-0.25, =SQR( ^2)LOCAL WINDGET COLOR 0,0,9999,9999ELSE =14COLOR 0,0,9999,9999ENDIF GRAPHMODE =SUB( =SUB( SQR(( )^2+( )^2)< RND(1) 0PSET ENDIF ENDIF GRAPHMODE RETURN File , ASCII _Load..., E_xit,, Graphics, _Moire, _Pulse _Circles, M_agic , _Rings,, Select, _?,, Text, _Mirror M_agnify, _Project, _Stretch, _Turn,, Special, _Mandelbrot _Betelguese,*/r , , , ,g | Figure _1 | Figure _2 | Figure _3 | Figure _4 | Figure _5o | Turtle _1 | Turtle _2_ | _Circle | _Lines | _Sine 256,256,256,256L 15,7,1,8,2,10,3,9,4,5,6,11,12,13,14,0 PROCEDURE entry lines :DATA ASCII _Load..., E_xit,, Graphics, _Moire, _PulseDATA _Circles, M_agic _Rings,, Select, Text, _Mirror M_agnify, _Project, _Stretch, _Turn,, Special, _Mandelbrot _Betelguese,*/ :DATA :DATA Figure Figure Figure Figure Figure _5DATA Turtle Turtle _2DATA _Circle _Lines _Sine :DATA :DATA 256,256,256,256 :DATA 15,7,1,8,2,10,3,9,4,5,6,11,12,13,14,0RETURN No further window available.|Help by closing one No Source-File retrieved a PROCEDURE entry ALERT messages further window available.|Help closing Source-File retrieved RETURN