DataMuseum.dk

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« 

TextFile

(* 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»