' GfA window demo ' by Stefan Posthuma ' ' Written 01-01-88 - 23-01-88 ' Happy newyear! ' ' special message regarding lifestyles at the end of this program text! ' ON BREAK GOSUB close_all ON ERROR GOSUB shit @init @event @close_all PROCEDURE init ' Restore the GEM-desktop @wind_get(0,4,*x,*y,*w,*h) @form_dial(3,x,y,w,h,x,y,w,h) ' Count menu-strings, initialize menu-bar and display it i%=0 REPEAT READ x$ INC i% UNTIL x$="**" DIM m$(i%),action%(i%) RESTORE FOR i1%=0 TO i%-1 READ m$(i1%) NEXT i1% FOR i1%=0 TO i%-1 READ action%(i1%) NEXT i1% MENU m$() MENU 12,2 ! disable 'close window' ' window names must be globals DIM w_name$(3) DIM handle%(3,1) FOR i%=0 TO 3 handle%(i%,0)=-1 ! -1 to mark empty handle slot NEXT i% DIM wind%(7,1) ! array to store slider values (8 possible window handles) ' set GEM-message routines ON MENU GOSUB menu_chosen ON MENU MESSAGE GOSUB gem_message the_end!=FALSE ' get text size for slider calculations @get_textsize chrbw%=DPEEK(PTSOUT+4) ! character box width chrbh%=DPEEK(PTSOUT+6) ! character box heigth txtsize%=200 ! let's say 200 lines of text in window txtwidth%=80 ! max 80 chars per line RETURN PROCEDURE event REPEAT ON MENU UNTIL the_end!=TRUE RETURN ' menubar message routine PROCEDURE menu_chosen LOCAL m%,a% m%=MENU(0) a%=action%(m%) ON a% GOSUB about,open_window,mclose_window,quit MENU OFF RETURN PROCEDURE mclose_window LOCAL w_handle%,dummy% @wind_get(0,10,*w_handle%,*dummy%,*dummy%,*dummy%) @close_window(w_handle%) RETURN ' GEM-message handler PROCEDURE gem_message LOCAL event% HIDEM ! get rid of mouse @wind_update(1) ! inform GEM that we are going to redraw windup!=TRUE event%=MENU(1) ! get event number IF event%=20 ! WM_REDRAW? @redraw(MENU(4),MENU(5),MENU(6),MENU(7),MENU(8)) ENDIF IF event%=21 ! WM_TOPPED? @wind_set(MENU(4),10,0,0,0,0) ENDIF IF event%=22 ! WM_CLOSED? @close_window(MENU(4)) ENDIF IF event%=23 ! WM_FULLED? @fulled(MENU(4)) ENDIF IF event%=24 ! WM_ARROWED? @arrowed(MENU(4),MENU(5)) ENDIF IF event%=25 ! WM_HSLID? @hslid(MENU(4),MENU(5)) ENDIF IF event%=26 ! WM_VSLID? @vslid(MENU(4),MENU(5)) ENDIF IF event%=27 OR event%=28 ! WM_SIZED? or WM_MOVED? @wind_set(MENU(4),5,MENU(5),MENU(6),MENU(7),MENU(8)) IF event%=27 ! if window resized, recalc slider values wind%(MENU(4),1)=0 @slid_calc(MENU(4),1,1) ENDIF ENDIF IF event%=30 ! WM_NEWTOP? if another window is closed @wind_set(MENU(4),10,0,0,0,0) ENDIF @wind_update(0) ! tell GEW we are ready windup!=FALSE SHOWM ! get mouse back RETURN ' ** HILDE IS THE GREATEST ** ' sorry, romantic outburst ' ' window routines ' ' redraw parts of a window PROCEDURE redraw(w_handle%,x1%,y1%,w1%,h1%) LOCAL x0%,y0%,w0%,h0%,ok% @wind_get(w_handle%,11,*x0%,*y0%,*w0%,*h0%) ! get first retangle from list WHILE (w0%<>0 AND h0%<>0) @rc_intersect(x1%,y1%,w1%,h1%,*x0%,*y0%,*w0%,*h0%,*ok%) IF ok% @draw(x0%,y0%,w0%,h0%) ENDIF @wind_get(w_handle%,12,*x0%,*y0%,*w0%,*h0%) ! get next retangle WEND RETURN PROCEDURE draw(x%,y%,w%,h%) DEFFILL 1,0,0 PBOX x%,y%,x%+w%,y%+h% DEFFILL 1,4,0 PELLIPSE x%+w%/2,y%+h%/2,w%/2,h%/2 RETURN ' full-size a window or reduce to its previous size when already full-sized PROCEDURE fulled(w_handle%) LOCAL curr_x%,curr_y%,curr_w%,curr_h% LOCAL prev_x%,prev_y%,prev_w%,prev_h% LOCAL full_x%,full_y%,full_w%,full_h% LOCAL ok% @wind_get(w_handle%,5,*curr_x%,*curr_y%,*curr_w%,*curr_h%) @wind_get(w_handle%,6,*prev_x%,*prev_y%,*prev_w%,*prev_h%) @wind_get(w_handle%,7,*full_x%,*full_y%,*full_w%,*full_h%) @rc_equal(curr_x%,curr_y%,curr_w%,curr_h%,full_x%,full_y%,full_w%,full_h%,*ok%) IF ok% @graf_shrinkbox(prev_x%,prev_y%,prev_w%,prev_h%,full_x%,full_y%,full_w%,full_h%) @wind_set(w_handle%,5,prev_x%,prev_y%,prev_w%,prev_h%) wind%(w_handle%,1)=0 @slid_calc(w_handle%,1,1) ELSE @graf_growbox(prev_x%,prev_y%,prev_w%,prev_h%,full_x%,full_y%,full_w%,full_h%) @wind_set(w_handle%,5,full_x%,full_y%,full_w%,full_h%) wind%(w_handle%,1)=0 @slid_calc(w_handle%,1,1) ENDIF RETURN ' menu routines PROCEDURE about LOCAL dummy% ALERT 1,"It's the Digital Insanity| Window Demo!| |** Dedicated to Hilde **",1,"How Nice",dummy% RETURN PROCEDURE open_window LOCAL w_handle%,x%,y%,w%,h%,i%,dummy%,attr%,w_name% ' find an empty window handle FOR i%=0 TO 3 EXIT IF handle%(i%,0)=-1 NEXT i% IF i%=4 ALERT 1,"Cannot open another window.",1,"TOO BAD",dummy% ELSE ' create a window attr%=1 OR 2 OR 4 OR 8 OR 32 ! NAME CLOSER FULLER MOVER SIZER attr%=attr% OR 64 OR 128 OR 256 OR 512 OR 1024 OR 2048 ' UPARROW DNARROW VSLIDE LFARROW RTARROW HSLIDE @wind_get(0,4,*x%,*y%,*w%,*h%) @wind_create(attr%,x%,y%,w%,h%) w_handle%=DPEEK(GINTOUT) IF w_handle%<-1 ALERT 1,"GEM does not permit|another open window!",1,"PROBLEM",dummy% ELSE handle%(i%,1)=w_handle% ! store window handle handle%(i%,0)=0 ! mark slot as being set w_name$(i%)=" Window #"+STR$(wind_count%)+" "+CHR$(0) w_name%=VARPTR(w_name$(i%)) ! get adress of window name @wind_set(w_handle%,2,w_name%,0,0,0) @wind_open(w_handle%,x%,y%,w%,h%) wind%(w_handle%,0)=0 ! needed for slider calculations (vertical) wind%(w_handle%,1)=0 ! idem for horizontal slider @slid_calc(w_handle%,1,1) ! set sliders INC wind_count% IF wind_count%=4 MENU 11,2 ! if all windows are open, disable 'open window' ENDIF MENU 12,3 ! enable 'close window' ENDIF ENDIF RETURN PROCEDURE close_window(w_handle%) LOCAL i%,dummy%,x0%,y0,w0,h0%,x1%,y1%,w1%,h1% FOR i%=0 TO 3 EXIT IF handle%(i%,1)=w_handle% NEXT i% IF i%=4 ALERT 1,"Cannot possibly close|an accessory window!",1," OK ",dummy% ELSE handle%(i%,0)=-1 ! mark handle as being empty @wind_get(0,5,*x0%,*y0%,*w0%,*h0%) @wind_get(handle%(i%,1),5,*x1%,*y1%,*w1%,*h1%) @graf_shrinkbox((x0%+w0%)/2,(y0%+h0%)/2,0,0,x1%,y1%,w1%,h1%) @wind_close(w_handle%) ! close and delete window @wind_delete(w_handle%) MENU 11,3 ! enable 'open window' DEC wind_count% IF wind_count%=0 MENU 12,2 ! disable 'close window' when all windows are closed ENDIF ENDIF RETURN PROCEDURE arrowed(w_handle%,kind%) LOCAL lns%,chrs%,vert%,hor% @wind_seen(w_handle%,*lns%,*chrs%) IF kind%=0 ! page up wind%(w_handle%,0)=MAX(0,wind%(w_handle%,0)-lns%) vert%=1 ENDIF IF kind%=1 ! page down wind%(w_handle%,0)=MIN(txtsize%,wind%(w_handle%,0)+lns%) vert%=1 ENDIF IF kind%=2 ! line up wind%(w_handle%,0)=MAX(0,wind%(w_handle%,0)-1) vert%=1 ENDIF IF kind%=3 ! line down wind%(w_handle%,0)=MIN(txtsize%,wind%(w_handle%,0)+1) vert%=1 ENDIF IF kind%=4 ! page left wind%(w_handle%,1)=MAX(0,wind%(w_handle%,1)-chrs%) hor%=1 ENDIF IF kind%=5 ! page right wind%(w_handle%,1)=MIN(txtwidth%,wind%(w_handle%,1)+chrs%) hor%=1 ENDIF IF kind%=6 ! char left wind%(w_handle%,1)=MAX(0,wind%(w_handle%,1)-1) hor%=1 ENDIF IF kind%=7 ! char right wind%(w_handle%,1)=MIN(txtwidth%,wind%(w_handle%,1)+1) hor%=1 ENDIF @slid_calc(w_handle%,vert%,hor%) RETURN PROCEDURE hslid(w_handle%,pos%) LOCAL lns%,chrs% @wind_seen(w_handle%,*lns%,*chrs%) wind%(w_handle%,1)=pos%*(txtwidth%-chrs%)/1000 @slid_calc(w_handle%,0,1) RETURN PROCEDURE vslid(w_handle%,pos%) LOCAL lns%,chrs% @wind_seen(w_handle%,*lns%,*chrs%) wind%(w_handle%,0)=pos%*(txtsize%-lns%)/1000 @slid_calc(w_handle%,1,0) RETURN PROCEDURE slid_calc(w_handle%,vert%,hor%) LOCAL x%,y%,w%,h%,lns%,chrs%,size% @wind_seen(w_handle%,*lns%,*chrs%) IF vert%=1 total%=txtsize% ! get lenght of text in lines size%=MIN(1000,1000*lns%/total%) ! vertical slider size pos%=1000*wind%(w_handle%,0)/(total%-lns%) ! vertical slider position @wind_set(w_handle%,16,size%,0,0,0) ! set vertical slider size @wind_set(w_handle%,9,pos%,0,0,0) ! set vertical slider position ENDIF IF hor%=1 total%=txtwidth% ! get width of text in characters size%=MIN(1000,1000*chrs%/total%) ! now calculate horizontal slider IF total%<=chrs% pos%=0 ELSE pos%=1000*wind%(w_handle%,1)/(total%-chrs%) ENDIF @wind_set(w_handle%,15,size%,0,0,0) @wind_set(w_handle%,8,pos%,0,0,0) ENDIF RETURN PROCEDURE quit LOCAL button% ALERT 1,"You sure you want to quit?!",1," YES | NO ",button% IF button%=1 the_end!=TRUE ENDIF RETURN PROCEDURE wind_seen(w_handle%,w_lines%,w_chars%) LOCAL x%,y%,w%,h% @wind_get(w_handle%,5,*x%,*y%,*w%,*h%) *w_lines%=h%/chrbh% ! lines in window *w_chars%=w%/chrbw% ! characters in window RETURN ' close all open windows PROCEDURE close_all LOCAL i%,w_handle%,dummy% ON BREAK CONT FOR i%=0 TO 3 IF handle%(i%,0)=0 @wind_close(handle%(i%,1)) @wind_delete(handle%(i%,1)) ENDIF NEXT i% IF windup!=TRUE @wind_update(0) ENDIF EDIT RETURN PROCEDURE wind_clr(w_handle%) LOCAL x%,y%,w%,h% @wind_get(w_handle%,4,*x%,*y%,*w%,*h%) @draw(x%,y%,w%,h%) RETURN ' menu-bar strings DATA Desk," About MyWindow ","-------------------",1,2,3,4,5,6,"" DATA Window," Open "," Close ",------------," Quit ","" DATA "",** DATA 0,1,0,0,0,0,0,0,0,0,0,2,3,0,4,0,0,0 ' Window routines PROCEDURE wind_get(wi_ghand%,wi_gfield%,wi_gsw1%,wi_gsw2%,wi_gsw3%,wi_gsw4%) DPOKE GINTIN,wi_ghand% DPOKE GINTIN+2,wi_gfield% GEMSYS 104 *wi_gsw1%=DPEEK(GINTOUT+2) *wi_gsw2%=DPEEK(GINTOUT+4) *wi_gsw3%=DPEEK(GINTOUT+6) *wi_gsw4%=DPEEK(GINTOUT+8) RETURN PROCEDURE wind_create(wi_kind%,wi_x%,wi_y%,wi_w%,wi_h%) DPOKE GINTIN,wi_kind% DPOKE GINTIN+2,wi_x% DPOKE GINTIN+4,wi_y% DPOKE GINTIN+6,wi_w% DPOKE GINTIN+8,wi_h% GEMSYS 100 RETURN PROCEDURE wind_open(wi_hand%,wi_x%,wi_y%,wi_w%,wi_h%) DPOKE GINTIN,wi_hand% DPOKE GINTIN+2,wi_x% DPOKE GINTIN+4,wi_y% DPOKE GINTIN+6,wi_w% DPOKE GINTIN+8,wi_h% GEMSYS 101 RETURN PROCEDURE wind_close(wi_hand%) DPOKE GINTIN,wi_hand% GEMSYS 102 RETURN PROCEDURE wind_delete(wi_hand%) DPOKE GINTIN,wi_hand% GEMSYS 103 RETURN PROCEDURE wind_set(wi_hand%,wi_field%,wi_sw1%,wi_sw2%,wi_sw3%,wi_sw4%) DPOKE GINTIN,wi_hand% DPOKE GINTIN+2,wi_field% IF wi_field%=14 OR wi_field%=2 OR wi_field%=3 LPOKE GINTIN+4,wi_sw1% LPOKE GINTIN+8,wi_sw2% ELSE DPOKE GINTIN+4,wi_sw1% DPOKE GINTIN+6,wi_sw2% DPOKE GINTIN+8,wi_sw3% DPOKE GINTIN+10,wi_sw4% ENDIF GEMSYS 105 RETURN PROCEDURE wind_find(wi_mx%,wi_my%) DPOKE GINTIN,wi_mx% DPOKE GINTIN+2,wi_my% GEMSYS 106 RETURN PROCEDURE wind_update(wi_upd%) DPOKE GINTIN,wi_upd% GEMSYS 107 RETURN PROCEDURE wind_calc(wi_type%,wi_kind%,wi_cx%,wi_cy%,wi_cw%,wi_ch%) DPOKE GINTIN,wind_type% DPOKE GINTIN+2,wind_kind% DPOKE GINTIN+4,wi_cx% DPOKE GINTIN+6,wi_cy% DPOKE GINTIN+8,wi_cw% DPOKE GINTIN+10,wi_ch% GEMSYS 108 RETURN ' special effects department PROCEDURE graf_growbox(gr_x%,gr_y%,gr_w%,gr_h%,gr_dx%,gr_dy%,gr_dw%,gr_dh%) DPOKE GINTIN,gr_x% DPOKE GINTIN+2,gr_y% DPOKE GINTIN+4,gr_w% DPOKE GINTIN+6,gr_h% DPOKE GINTIN+8,gr_dx% DPOKE GINTIN+10,gr_dy% DPOKE GINTIN+12,gr_dw% DPOKE GINTIN+14,gr_dh% GEMSYS 73 RETURN PROCEDURE graf_shrinkbox(gr_x%,gr_y%,gr_w%,gr_h%,gr_dx%,gr_dy%,gr_dw%,gr_dh%) DPOKE GINTIN,gr_x% DPOKE GINTIN+2,gr_y% DPOKE GINTIN+4,gr_w% DPOKE GINTIN+6,gr_h% DPOKE GINTIN+8,gr_dx% DPOKE GINTIN+10,gr_dy% DPOKE GINTIN+12,gr_dw% DPOKE GINTIN+14,gr_dh% GEMSYS 74 RETURN ' miscellaneous ' calculate intersection between two retangles PROCEDURE rc_intersect(x0%,y0%,w0%,h0%,p_x1%,p_y1%,p_w1%,p_h1%,p_ok%) LOCAL tx%,ty%,tw%,th%,dummy% tw%=MIN(x1%+w1%,x0%+w0%) th%=MIN(y1%+h1%,y0%+h0%) tx%=MAX(x1%,x0%) ty%=MAX(y1%,y0%) *p_x1%=tx% *p_y1%=ty% *p_w1%=tw%-tx% *p_h1%=th%-ty% IF (tw%>tx%) AND (th%>ty%) *p_ok%=TRUE ELSE *p_ok%=FALSE ENDIF RETURN ' check if two retangles are equal PROCEDURE rc_equal(x0%,y0%,w0%,h0%,x1%,y1%,w1%,h1%,p_ok%) IF (x0%<>x1% OR y0%<>y1% OR w0%<>w1% OR h0%<>h1%) *p_ok%=FALSE ELSE *p_ok%=TRUE ENDIF RETURN ' form_dial PROCEDURE form_dial(fo_flag%,fo_x1%,fo_y1%,fo_w1%,fo_h1%,fo_x2%,fo_y2%,fo_w2%,fo_h2%) DPOKE GINTIN,fo_flag% DPOKE GINTIN+2,fo_x1% DPOKE GINTIN+4,fo_y1% DPOKE GINTIN+6,fo_w1% DPOKE GINTIN+8,fo_h1% DPOKE GINTIN+10,fo_x2% DPOKE GINTIN+12,fo_y2% DPOKE GINTIN+14,fo_w2% DPOKE GINTIN+16,fo_h2% GEMSYS 51 RETURN PROCEDURE get_textsize LOCAL v% v%=DPEEK(CONTRL+12) GEMSYS 77 DPOKE CONTRL+12,DPEEK(GINTOUT) VDISYS 38 DPOKE CONTRL+12,v% RETURN PROCEDURE shit fout=error @close_all RETURN ' Well, that's it. ' ' I advise you to listen to Wally Jump Jnr, Pet Shop Boys, Beasty Boys, ' Art of Noise, Jeff Wayne, Ben Liebrand, Jean Michel Jarre, Michael Garrison, ' Public Enemy, Kitaro, Tangerine Dream, LL Cool J, ZZ Top, Herb Alpert, ' Erik B & Rakim and Johan Sebastian Bach ' These dudes make great music! ' While playing this music (especially Beasty Boys and Public Enemy) take ' care of angry parents or neighbours with exeptionally large and heavy ' destruction tools approaching your stereo with a very negative look on ' their faces. In case of JS Bach, try to keep your father from stealing ' your record (like mine). ' ' I advise you to eat Crispy Chips (paprika flavour). They really ' 'smaken zoals ze kraken' (this is a computer man!..teim is munnie!) ' ' I advise you to drink Heineken, Amstel or Bavaria beer. It is refreshing, ' cool, stimulating, brain-clearing and appetising. ' But try to stick to one crate at a time, else it will become brain-smashing ' ' I advise you to go out on Saturdaynight (preferably with Hilde) in Den Bosch ' (hit 'Pumpke', 'De oetel', 'Het Hart', and finally 'Kings Cross') and ' return at five o'clock in the morning. Sleep till two o'clock, play Bubble ' Bobble with your sister and reach level 83! ' ' I advise you to think of Hilde. She is 19 years old, blond, cute, funny, ' bright, intelligent, beautiful, nice, stimulating, inspiring, lovely, ' exiting, jolly, cheerful, tender, companionable and a lot more ' (I am starting to sound like Richard here!) ' (If you are a female reader, think of Tom Cruise, Rob Lowe or some other ' fancy looking guy. My sister Melanie is crazy about them anyway) ' ' I advise you to write articles and send them in to the ST NEWS correspondence ' adress on a single sided disk, in 1STWord format. Good articles will be ' published and you will become famous! You will do our good friend and ' Master Editor Richard a favour. ' ' I do NOT advise you to go out and buy clothes with your 17-year old sister. ' You'll end up with clothes that are either very expensive (Naf-Naf stuff ' looks great though) or a bit too small. (Small enough to fit your sister) ' (or in the worst case, both. In which case your sister wears them all the ' time, looking very good and proud in your expensive clothes) ' ' Do all these things and end up like me, senior executive of Digital Insanity! ' ' BYE!