Millennium Time Capsule/AC2000.BIN/disks/ac4_disk/hbasic/demos/aesdemo.bas

BASIC Source File | 1987-07-27 | 8.4 KB | 304 lines

'   An AES demo program written in HiSoft BASIC
'   by Dave Nutkins
' Note that this will not compile immediately since it uses
' GEMAES.BH on Disc 2. See Chapter 8 for more details.

rem $option v

DEFINT a-z
LIBRARY "gemvdi","gemaes"
REM $INCLUDE gemaes.bh

' some constants for WINDOW GET/READ etc commands
CONST window_hslide=0, window_vslide=1, window_hsize=2, window_vsize=3
CONST window_front=4, read_window_handle=5, read_window_id=6

CONST get_usable=0,get_total=1,get_max=2,get_first=3,get_next=4

'initialise the data structures used for storing the characters
text=-1    ' -1 if written to this string 0 if only set attributes
string_max=100
DIM types(string_max,1),strings$(string_max)
store_info 0,10    '10 point to start
store_info 1,0    ' no effects

'the data for the point sizes
DIM points(2)
FOR i=0 to 2: read points(i): next i
DATA 10,18,24


menu$="[ Desk |  About me...][ File | Quit ]"
menu$=menu$+"[ Style |  10 point \  18 point \  24 point \(---------------\  Bold \  Grey \  Italic \  Underline \  Outline ]"

' the menu title menus
CONST file_title=4,style_title=5, about=8, quit=17
point10=19
bold=point10+4
outline=bold+4


menu_pointer&=FNmenu&(menu$)

' this piece of code would disable the desk accessories
'for i=10 to 15
'            menu_ienable menu_pointer&,i,0
'next i

CONST our_window=2

DIM d(9)' only used to store the distances in print_string
DIM mess(7)    'for the messages


WINDOW OFF        ' program is controlling the windows not the runtimes

WINDOW READ our_window,read_window_handle,our_aeshandle
WINDOW GET our_window,get_total,bigx,bigy,bigw,bigh
'bigx,bigy,bigw,bigh hold the maximum size of our window

MOUSE 0

moved_window    ' to initialise the window sizes etc
' i.e. (topx,topy,botx,boty) VDI rectangle for our_window
' curx,cury position to write text at (starts at topx,topy)



'oldx,oldy,oldw,oldh hold the size to return to after the full box
' is clicked twice

oldx=bigx: oldy=bigy: oldw=bigw: oldh=bigh

'use the top left corner for text alignment; this makes the calculations
' easy but doesn't look good with different sizes.
vst_alignment 0,5


DO
    e=FNevnt_multi(MU_MESAG+MU_KEYBD,0,0,0,0,0,0,0,0,0,0,0,0,0,_
                    varptr(mess(0)),0,0,0,0,0,k,0)


    IF e AND MU_MESAG THEN do_message mess(0)  'there was a message
    IF e AND MU_KEYBD THEN    ' a character was typed.
        junk=FNwind_update(1)
        char=k AND 255        ' the actual ASCII character
        IF char=27 THEN        'escape
            redraw topx,topy,botx-topx-1,boty-topy-1
        ELSEIF char=17 THEN    'ctrl Q
             junk=FNwind_update(0)
            goto finished
        ELSE
            MOUSE -1
            print_string chr$(char)
            MOUSE 0
            store_string chr$(char)
        END IF
         junk=FNwind_update(0)
    END IF
LOOP
finished:    stop    -1    ' stop without asking for a key

SUB do_message(val mes_type)
SHARED mess(1),menu_pointer&,point10,bold,outline,our_aeshandle
SHARED topx,topy,botx,boty,oldx,oldy,oldw,oldh,bigx,bigy,bigh,bigw
STATIC title,item,junk,x,y,w,h,cur_front
 IF mes_type>=WM_TOPPED AND mes_type<=WM_MOVED THEN
    IF mess(3)<>our_aeshandle THEN EXIT SUB    'its not our window
 END IF
 SELECT CASE mes_type
 CASE MN_SELECTED:
    ' its a menu
    WINDOW READ 0,window_front,cur_front
    title=mess(3)
    IF cur_front=our_window THEN
        ' we are at the front
        item=mess(4)
        SELECT CASE item
        CASE about: junk=FNform_alert(1,"[0][ An Example Program Written  |      in HiSoft BASIC ][ OK ]")
        CASE quit : goto finished
        CASE point10 TO point10+3:    do_points item
        CASE bold TO outline:do_effects item
        END SELECT
    END IF
    ' un-highlight the menu item even if not at front
    menu_tnormal menu_pointer&,title,1
 CASE WM_REDRAW:
    redraw mess(4),mess(5),mess(6),mess(7)
 CASE WM_TOPPED:
    full_redraw
 CASE WM_CLOSED: goto finished
 CASE WM_SIZED,WM_MOVED:
    make_window mess(4),mess(5),mess(6),mess(7)
 CASE WM_FULLED:
    WINDOW GET our_window,get_total,x,y,w,h    'current size
    IF bigw<>w OR bigh<>h OR bigx<>x OR bigy<>y THEN
            ' make as large as possible
            make_window bigx,bigy,bigw,bigh
            oldx=x: oldy=y: oldw=w:oldh=h
    ELSE
            ' make to the old size
            make_window oldx,oldy,oldw,oldh
    END IF
 END SELECT
END SUB

' actually writes x$ to the screen
SUB print_string(x$)
SHARED curx,cury,maxy,topx,botx,d(1)
    vqt_extent x$,d()         'd() now contains the dimensions required to print this
    IF curx+d(4)>botx THEN
            ' new line required
            curx=topx: cury=cury+maxy: maxy=0
    END IF
    IF d(5)>maxy THEN maxy=d(5)        ' taller character than any we have had
    v_gtext curx,cury,x$        ' write the text
    curx=curx+d(4)                ' update the x co-ordinate
END SUB

' The points parts of the menu
SUB do_points(m)
SHARED menu_pointer&,points(1),point10
STATIC cur_point_menu
    menu_icheck menu_pointer&,cur_point_menu,0    ' untick the old item
    cur_point_menu=m                ' remember for unticking next time
    vst_point points(m-point10)        ' set the size
    menu_icheck menu_pointer&,m,1    ' tick the new size
    store_info 0,points(m-point10)  ' store in data structure
END SUB

'The style parts of the menu
SUB do_effects(m)
SHARED menu_pointer&,bold
STATIC newmask,effects,state
    newmask=FNtwo(m-bold)    'the mask we are setting or removing
    state=effects AND newmask
    IF state THEN
                ' was set before now off
        menu_icheck menu_pointer&,m,0
        effects=effects-newmask    ' update effects
    ELSE
        menu_icheck menu_pointer&,m,1
        effects=effects+newmask    ' on
    END IF
    vst_effects effects        'set new effects
    store_info 1,effects    ' remember info
END SUB

' returns 2^i
DEF FNtwo(i)
STATIC k,j
j=1
for k=1 to i: j=j*2: next k
FNtwo=j
END def

' The next 2 routines store the internal data structure
' This consists of a collection of strings each with the same effects
' and size info.
' There are topstr strings
' the strings themselves are in strings$ and the
'  types(x,0) stores the points, types(x,1) the effects for this string
' -1 in these fields indicates un-used
' if text=-1 then we have added some characters to this string

'store_string adds x$ to the current string
SUB store_string(x$)
SHARED topstr,text,strings$(1)
  text=-1
  strings$(topstr)=strings$(topstr)+x$
END SUB

' sets the current effects
SUB store_info(type,value)
SHARED topstr,text,types(2)
IF text THEN
' new string needed
' default leave alone
    topstr=topstr+1: types(topstr,0)=-1: types(topstr,1)=-1
    text=0
END IF
 types(topstr,type)=value
END SUB


' The redraw routines

'redraw is called when the AES sends a redraw message and takes note
' of the update rectangles
SUB redraw(val x,val y,val w,val h)
SHARED botx,boty,topx,topy
STATIC junk
STATIC x1,y1,w1,h1,x2,y2,w2,h2
MOUSE -1
junk=FNwind_update(1)
WINDOW GET our_window,get_first,x1,y1,w1,h1
DO
    IF w1=0 or h1=0 THEN EXIT LOOP
    INTERSECTION x,y,w,h,x1,y1,w1,h1,x2,y2,w2,h2
    base_redraw x2,y2,w2,h2
    WINDOW GET our_window,get_next,x1,y1,w1,h1
LOOP
vs_clip 1,topx,topy,botx,boty    'restore the clipping rectangle
junk=FNwind_update(0)
MOUSE 0
END SUB

' redraws the entire screen regardless of the update rectangle
SUB full_redraw
SHARED topx,topy,botx,boty
STATIC junk
    WINDOW CONTRL our_window,window_front,0 ' make us the front
    MOUSE -1
    junk=FNwind_update(1)
    base_redraw topx,topy,botx-topx-1,boty-topy-1
    junk=FNwind_update(0)
    MOUSE 0
END SUB

' the low level redraw routine which does not remove the mouse etc

SUB base_redraw(x2,y2,w2,h2)
SHARED curx,topx,cury,topy,maxy,types(2),strings$(1),topstr
STATIC i,j
    IF w2>0 AND h2>0 THEN
        vsf_color 0            ' fill with white

' set the clipping rectangle and clear it
        vs_clip 1,x2,y2,x2+w2-1,y2+h2-1
        vr_recfl x2,y2,x2+w2-1,y2+h2-1
' reset the pointers for the string drawing
        curx=topx: cury=topy: maxy=0

        FOR i=1 TO topstr
            ' set the size and effects for this string
            IF types(i,0)>-1 THEN vst_point types(i,0)
            IF types(i,1)>-1 THEN vst_effects types(i,1)

            ' write the string one character at a time
            FOR j=1 TO len(strings$(i))
                print_string mid$(strings$(i),j,1)
            NEXT j
        NEXT i
    END IF
END SUB

' called when the window is moved or changes size
SUB make_window(x,y,w,h)
WINDOW LOCATE our_window,x,y,w,h
moved_window
full_redraw
END SUB


' update the window variables after the window has moved.
SUB moved_window
SHARED topx,topy,botx,boty,curx,cury,maxy
WINDOW GET our_window,get_usable,topx,topy,botx,boty
botx=botx+topx+1
boty=boty+topy+1
maxy=0    ' maxy is the highest character printed on the current line
curx=topx: cury=topy
END SUB