|
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: 3968 (0xf80) Types: TextFile Names: »SKOLNODE.BAK«
└─⟦4fbcde1e4⟧ Bits:30003931/GEM_Development-A.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline) └─⟦this⟧ »SKOLNODE.BAK«
(* SKOLNODE the very first work SBJ 22/12 1989 *) (* GEM *) (* -------------------------------------- GEM INCLUDE FILES -------------- *) (*$Igempcon.i*) (*$Igemptype.i*) (*$Igempvar.i*) (*$Ivdibnd.pas*) (*$Igempatyp.i*) (*$Igempavar.i*) (*$Iaesbnd.pas*) (*$Icstring.pas*) (*--------------------------------------- CONSTANTS DECLARATIONS -------- *) CONST (*$I skolnode.i*) arrow = 0; hour_glass = 2; desk = 0; end_update = 0; BEG_UPDATE = 1; long0:address = (LO:0;HI:0); (************************************************************************) (**** 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; snmenu_adr,editpage_adr :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 dummy:=graf_mouse(hour_glass,long0); dummy:=menu_bar(snmenu_adr,10); dummy:=form_center(editpage_adr,x,y,w,h); dummy:=objc_draw(editpage_adr,editpage,2,x,y,w,h); dummy:=graf_mouse(arrow,long0); dummy:=evnt_timer(10000,0); end; (* ------------------------------------------------ AES_INIT ---------- *) PROCEDURE aes_init; VAR i : INTEGER; work_in : intin_array; BEGIN gl_apid := appl_init; (* initialize libraries , return applikation ID *) 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,editpage,editpage_adr); dummy:=rsrc_gaddr(0,snmenu,snmenu_adr); END; (* ------------------------------------------------- AES_END ---------- *) PROCEDURE aes_end; BEGIN dummy:=rsrc_free; dummy:=v_clsvwk(vdi_handle); dummy:=appl_exit; END; (* ---------------------------------------------- Main Progam --------- *) BEGIN MakeCString('SKOLNODE.RSC',rsc); rsc_file.hi:=seg(rsc); rsc_file.lo:=ofs(rsc); aes_init; dial_loop; aes_end; END. «eof»