|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 5504 (0x1580) Types: TextFile Names: »DIALOG.BAK«
└─⟦4fbcde1e4⟧ Bits:30003931/GEM_Development-A.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline) └─⟦this⟧ »DIALOG.BAK«
(************************************************************************) (* File: dialog.pas *) (************************************************************************) (* *) (* GGGGG EEEEEEEE MM MM *) (* GG EE MMMM MMMM *) (* GG GGG EEEEE MM MM MM *) (* GG GG EE MM MM *) (* GGGGG EEEEEEEE MM MM *) (* *) (************************************************************************) (* *) (* Author: Mogens Rode *) (* PRODUCT: GEM Dialogbehandling *) (* Module: DIALOG *) (* Version: 87.03.19 *) (* *) (************************************************************************) (* \f ▶83◀▶f8◀ (*------------------------------*) (* includes *) (*------------------------------*) (*$Igempcon.i*) (*$Igemptype.i*) (*$Igempvar.i*) (*$Ivdibnd.pas*) (*$Igempatyp.i*) (*$Igempavar.i*) (*$Iaesbnd.pas*) (*$Icstring.pas*) (*------------------------------*) (* defines *) (*------------------------------*) CONST (*$IDIALOG.i*) ARROW= 0; HOUR_GLASS= 2; DESK= 0; END_UPDATE= 0; BEG_UPDATE= 1; LONG0:ADDRESS = (lo:0;hi:0); (* \f ▶86◀▶80◀ (************************************************************************) (************************************************************************) (**** ****) (**** Data Structures ****) (**** ****) (************************************************************************) (************************************************************************) TYPE GRECT = Record g_x,g_y,g_w,g_h : integer; End; VAR (*------------------------------*) (* Local *) (*------------------------------*) gl_wchar:integer; (* character width *) gl_hchar:integer; (* character height *) gl_wbox:integer; (* box (cell) width *) gl_hbox:integer; (* box (cell) height *) gem_handle:integer; (* GEM vdi handle *) vdi_handle:integer; (* hello vdi handle *) work_out:ARRAY_57; (* open virt workstation values *) work_area:GRECT; (* current window work area *) gl_apid:integer; (* application ID *) gl_rmsg:ARRAY_8; (* message buffer *) ad_rmsg:ADDRESS; (* LONG pointer to message bfr *) gl_itemhello:integer; (* hello menu item *) gl_xfull:integer; (* full window 'x' *) gl_yfull:integer; (* full window 'y' *) gl_wfull:integer; (* full window 'w' width *) gl_hfull:integer; (* full window 'h' height *) ev_which:integer; (* event message returned value *) hello_whndl :integer; (* hello window handle *) type_size:integer; (* system font cell size *) dummy:integer; b:boolean; gl_dialog:ADDRESS; (* dialog adress *) rsc:CharString; rsc_file:ADDRESS; (*------------------------------*) (* set_flag *) (*------------------------------*) PROCEDURE set_flag(tree:address;obj,flag:integer;xset:boolean); Var a : address; Begin a.lo:=tree.lo+(24*obj)+8; a.hi:=tree.hi; if xset then a.gwp^:=a.gwp^ OR flag else a.gwp^:=a.gwp^ AND (NOT flag); End; (*------------------------------*) (* dial_loop *) (*------------------------------*) PROCEDURE dial_loop; VAR x,y,w,h : integer; ix,iy,iw,ih : integer; unhidden : integer; xit : integer; Begin unhidden:=mus; dummy:=form_center(gl_dialog,x,y,w,h); ix:=0; iy:=0; iw:=0; ih:=0; dummy:=form_dial(0,ix,iy,iw,ih,x,y,w,h); dummy:=objc_draw(gl_dialog,DIALOG,2,x,y,w,h); repeat xit:=form_do(gl_dialog,-1); dummy:=objc_change(gl_dialog,xit,0,x,y,w,h,0,1); set_flag(gl_dialog,unhidden,$80(*HIDETREE*),TRUE); case xit of LILLE : unhidden:=MUS; MELLEM : unhidden:=KAT; STOR : unhidden:=ELEFANT; OTHERWISE end; set_flag(gl_dialog,unhidden,$80(*HIDETREE*),FALSE); dummy:=objc_draw(gl_dialog,DIALOG,2,x,y,w,h); until xit=SLUT; dummy:=evnt_timer(2000,0); dummy:=form_dial(3,ix,iy,iw,ih,x,y,w,h); end; (*------------------------------*) (* aes_init *) (*------------------------------*) procedure aes_init; var i : integer; work_in : intin_ARRAY; begin gl_apid := appl_init; (* initialize libraries *) for i:=0 TO 9 do work_inÆiÅ:=1; work_inÆ10Å:=0; gem_handle := graf_handle(gl_wchar,gl_hchar,gl_wbox,gl_hbox); vdi_handle := gem_handle; dummy:=v_opnvwk(work_in,vdi_handle,work_out); (* open virtual work stn*) if vdi_handle=0 then begin writeln('Kan ikke åbne Workstation'); exit; end; if rsrc_load(rsc_file)=0 then begin writeln('Kan ikke åbne resource-fil'); end; dummy:=rsrc_gaddr(0,dialog,gl_dialog); set_flag(gl_dialog,MUS,$80(*HIDETREE*),TRUE); set_flag(gl_dialog,KAT,$80(*HIDETREE*),TRUE); set_flag(gl_dialog,ELEFANT,$80(*HIDETREE*),TRUE); end; (*------------------------------*) (* aes_end *) (*------------------------------*) procedure aes_end; begin dummy:=rsrc_free; dummy:=v_clsvwk(vdi_handle); dummy:=appl_exit; end; (*------------------------------*) (* Main *) (*------------------------------*) Begin MakeCString('DIALOG.RSC',rsc); rsc_file.hi:=seg(rsc); rsc_file.lo:=ofs(rsc); aes_init; dial_loop; aes_end; End. «eof»