diff options
49 files changed, 7559 insertions, 352 deletions
diff --git a/INSTALL.MPW b/INSTALL.MPW index 4348c7b42..9162207c6 100644 --- a/INSTALL.MPW +++ b/INSTALL.MPW @@ -1,6 +1,7 @@ # PREREQUISITES # -# You need MPW 3.4.1 or 3.4.2 (with SC and MrC). +# You need MPW 3.4.1 or 3.4.2 (with MrC). +# You also need MWC68k from Code Warrior Pro 3 # # MPW 3.4.2 is available from Apple's FTP site at: # <ftp://ftp.apple.com/devworld/Tool_Chest/Core_Mac_OS_Tools/MPW_etc./> diff --git a/Makefile.Mac b/Makefile.Mac index f374497cb..9aa9476c4 100644 --- a/Makefile.Mac +++ b/Makefile.Mac @@ -1,6 +1,6 @@ # The main Makefile -MacVersion = "Mac0.3" +MacVersion = "Mac{MAJOR}.{MINOR}{STAGE}{REV}" CAMLC = :boot:ocamlrun :boot:ocamlc -I :boot: COMPFLAGS = {INCLUDES} @@ -73,7 +73,8 @@ PERVASIVES = arg array callback char digest filename format gc hashtbl ¶ marshal # Recompile the system using the bootstrap compiler -all Ä runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml otherlibraries +all Ä runtime ocamlc ocamllex ocamlyacc ocamltools library ocaml ¶ + otherlibraries maccaml # The compilation of ocaml will fail if the runtime has changed. # Never mind, just do make bootstrap to reach fixpoint again. @@ -169,10 +170,10 @@ compare Ä cleanboot Ä delete -i -y :boot:Saved:Saved.prev:Å || set status 0 -# Installation + install Ä $OutOfDate flush - for i in "{BINDIR}" "{LIBDIR}" + for i in "{BINDIR}" "{LIBDIR}" "{APPLIDIR}" "{APPLIDIR}stdlib:" if "`exists -d "{i}"`" == "" newfolder "{i}" end @@ -199,9 +200,14 @@ install Ä $OutOfDate domake install directory ::: end + duplicate -y "{LIBDIR}"Å "{APPLIDIR}stdlib:" + directory :maccaml: + domake install + directory :: clean ÄÄ partialclean + # The compiler ocamlc Ä {COMPOBJS} @@ -210,6 +216,7 @@ ocamlc Ä {COMPOBJS} partialclean ÄÄ delete -i ocamlc + # The toplevel ocaml Ä toplevellib.cma {TOPLEVELMAIN} expunge @@ -223,6 +230,7 @@ toplevellib.cma Ä {TOPLIB} partialclean ÄÄ delete -i ocaml toplevellib.cma + # The configuration file :utils:config.ml Ä :utils:config.mlp :config:config.Mac @@ -239,6 +247,7 @@ partialclean ÄÄ beforedepend ÄÄ :utils:config.ml + # The parser :parsing:parser.mli Ä :parsing:parser.ml @@ -252,6 +261,7 @@ partialclean ÄÄ beforedepend ÄÄ :parsing:parser.mli :parsing:parser.ml + # The lexer :parsing:lexer.ml Ä :parsing:lexer.mll @@ -262,6 +272,7 @@ partialclean ÄÄ beforedepend ÄÄ :parsing:lexer.ml + # The auxiliary lexer for counting line numbers :parsing:linenum.ml Ä :parsing:linenum.mll @@ -272,6 +283,7 @@ partialclean ÄÄ beforedepend ÄÄ :parsing:linenum.ml + # The numeric opcodes :bytecomp:opcodes.ml Ä :byterun:instruct.h @@ -282,6 +294,7 @@ partialclean ÄÄ beforedepend ÄÄ :bytecomp:opcodes.ml + # The predefined exceptions and primitives :byterun:primitives Ä @@ -302,6 +315,7 @@ partialclean ÄÄ beforedepend ÄÄ :bytecomp:runtimedef.ml + # The "expunge" utility expunge Ä {EXPUNGEOBJS} @@ -310,6 +324,7 @@ expunge Ä {EXPUNGEOBJS} partialclean ÄÄ delete -i expunge + # The runtime system for the bytecode compiler runtime Ä @@ -319,6 +334,7 @@ clean ÄÄ alldepend ÄÄ directory :byterun:; domake depend; directory :: + # The library library Ä ocamlc @@ -330,6 +346,7 @@ partialclean ÄÄ alldepend ÄÄ directory :stdlib; domake depend; directory :: + # The lexer and parser generators ocamllex Ä ocamlyacc ocamlc @@ -344,6 +361,7 @@ ocamlyacc Ä clean ÄÄ directory :yacc; domake clean; directory :: + # Tools ocamltools Ä ocamlc ocamlyacc ocamllex @@ -353,6 +371,7 @@ partialclean ÄÄ alldepend ÄÄ directory :tools; domake depend; directory :: + # The extra libraries otherlibraries Ä @@ -372,13 +391,25 @@ alldepend ÄÄ directory :otherlibs:{i}; domake depend; directory ::: end + +# The standalone application + +maccaml Ä + directory :maccaml:; domake all; directory :: +clean ÄÄ + directory :maccaml:; domake clean; directory :: +alldepend ÄÄ + directory :maccaml:; domake depend; directory :: + + # Clean up the test directory clean ÄÄ - if `exists :test` - directory :test; domake clean; directory :: + if `exists :test:` + directory :test:; domake clean; directory :: end + # Default rules .cmo Ä .ml @@ -399,5 +430,6 @@ depend Ä beforedepend alldepend ÄÄ depend + # Make sure the config file was executed dummy Ä {OTHERLIBRARIES} diff --git a/Makefile.Mac.depend b/Makefile.Mac.depend index 5c4978466..3915bfe3e 100644 --- a/Makefile.Mac.depend +++ b/Makefile.Mac.depend @@ -335,15 +335,15 @@ :bytecomp:translcore.cmx :bytecomp:translobj.cmx :typing:typedtree.cmx ¶ :bytecomp:typeopt.cmx :typing:types.cmx :bytecomp:translclass.cmi :bytecomp:translcore.cmoÄ :parsing:asttypes.cmi :utils:clflags.cmo ¶ - :utils:config.cmi :typing:env.cmi :typing:ident.cmi :bytecomp:lambda.cmi ¶ - :parsing:location.cmi :bytecomp:matching.cmi :utils:misc.cmi ¶ - :typing:path.cmi :typing:predef.cmi :typing:primitive.cmi ¶ + :utils:config.cmi :typing:ctype.cmi :typing:env.cmi :typing:ident.cmi ¶ + :bytecomp:lambda.cmi :parsing:location.cmi :bytecomp:matching.cmi ¶ + :utils:misc.cmi :typing:path.cmi :typing:predef.cmi :typing:primitive.cmi ¶ :bytecomp:translobj.cmi :typing:typedtree.cmi :bytecomp:typeopt.cmi ¶ :typing:types.cmi :bytecomp:translcore.cmi :bytecomp:translcore.cmxÄ :parsing:asttypes.cmi :utils:clflags.cmx ¶ - :utils:config.cmx :typing:env.cmx :typing:ident.cmx :bytecomp:lambda.cmx ¶ - :parsing:location.cmx :bytecomp:matching.cmx :utils:misc.cmx ¶ - :typing:path.cmx :typing:predef.cmx :typing:primitive.cmx ¶ + :utils:config.cmx :typing:ctype.cmx :typing:env.cmx :typing:ident.cmx ¶ + :bytecomp:lambda.cmx :parsing:location.cmx :bytecomp:matching.cmx ¶ + :utils:misc.cmx :typing:path.cmx :typing:predef.cmx :typing:primitive.cmx ¶ :bytecomp:translobj.cmx :typing:typedtree.cmx :bytecomp:typeopt.cmx ¶ :typing:types.cmx :bytecomp:translcore.cmi :bytecomp:translmod.cmoÄ :parsing:asttypes.cmi :typing:ident.cmi ¶ @@ -483,9 +483,11 @@ :typing:types.cmx :toplevel:toploop.cmi :toplevel:topmain.cmoÄ :utils:clflags.cmo :toplevel:toploop.cmi :toplevel:topmain.cmxÄ :utils:clflags.cmx :toplevel:toploop.cmx -:toplevel:trace.cmoÄ :typing:ctype.cmi :parsing:longident.cmi :utils:misc.cmi ¶ - :typing:path.cmi :typing:printtyp.cmi :toplevel:printval.cmi ¶ - :toplevel:toploop.cmi :typing:types.cmi :toplevel:trace.cmi -:toplevel:trace.cmxÄ :typing:ctype.cmx :parsing:longident.cmx :utils:misc.cmx ¶ - :typing:path.cmx :typing:printtyp.cmx :toplevel:printval.cmx ¶ - :toplevel:toploop.cmx :typing:types.cmx :toplevel:trace.cmi +:toplevel:trace.cmoÄ :typing:ctype.cmi :parsing:longident.cmi ¶ + :bytecomp:meta.cmi :utils:misc.cmi :typing:path.cmi :typing:printtyp.cmi ¶ + :toplevel:printval.cmi :toplevel:toploop.cmi :typing:types.cmi ¶ + :toplevel:trace.cmi +:toplevel:trace.cmxÄ :typing:ctype.cmx :parsing:longident.cmx ¶ + :bytecomp:meta.cmx :utils:misc.cmx :typing:path.cmx :typing:printtyp.cmx ¶ + :toplevel:printval.cmx :toplevel:toploop.cmx :typing:types.cmx ¶ + :toplevel:trace.cmi diff --git a/byterun/Makefile.Mac b/byterun/Makefile.Mac index 0c79792d9..45e471a9e 100644 --- a/byterun/Makefile.Mac +++ b/byterun/Makefile.Mac @@ -1,14 +1,17 @@ C = sc COptions = -model far -AOptions = -model far -wb +AOptions = -model far LinkOptions = -model far -msg nodup -compact -pad 0 -state nouse -br 68k -Libs = "{libraries}IntEnv.far.o" "{libraries}MacRuntime.o" ¶ - "{clibraries}StdCLib.far.o" "{libraries}MathLib.far.o" ¶ - "{libraries}ToolLibs.o" "{libraries}Interface.o" - -PPCC = mrc +Libs = "{libraries}IntEnv.o" ¶ + "{libraries}Interface.o" ¶ + "{libraries}MacRuntime.o" ¶ + "{libraries}MathLib.o" ¶ + "{clibraries}StdCLib.o" ¶ + "{libraries}ToolLibs.o" + +PPCC = mrc -sym on PPCCOptions = -w 35 -PPCLinkOptions = -d +PPCLinkOptions = -d -sym on PPCLibs = "{sharedlibraries}MathLib" "{ppclibraries}PPCCRuntime.o" ¶ "{ppclibraries}PPCToolLibs.o" "{sharedlibraries}StdCLib" ¶ "{ppclibraries}StdCRuntime.o" "{sharedlibraries}InterfaceLib" @@ -41,7 +44,7 @@ all Ä ocamlrun libcamlrun.o libcamlrun.x ocamlrun ÄÄ libcamlrun.o prims.c.o ilink -c 'MPS ' -t MPST {LinkOptions} -o ocamlrun prims.c.o ¶ - libcamlrun.o {Libs} + libcamlrun.o {libs} ocamlrun ÄÄ libcamlrun.x prims.c.x ppclink -c 'MPS ' -t MPST {PPCLinkOptions} -o ocamlrun prims.c.x ¶ @@ -83,7 +86,8 @@ clean Ä delete -i ocamlrun primitives prims.c opnames.h primitives Ä {PRIMS} - streamedit -d -e "/ ([a-z0-9_]+)¨0 *'('Å'* ML *'/ print ¨0" {PRIMS} > primitives + streamedit -d -e "/ ([a-z0-9_]+)¨0 *'('Å'* ML *'/ print ¨0" {PRIMS} ¶ + > primitives prims.c Ä primitives echo '#include "mlvalues.h"' > prims.c diff --git a/byterun/Makefile.Mac.depend b/byterun/Makefile.Mac.depend index abb3b6c88..bd64d7f1f 100644 --- a/byterun/Makefile.Mac.depend +++ b/byterun/Makefile.Mac.depend @@ -380,10 +380,11 @@ config.h ¶ ::config:sm-Mac.h ¶ mlvalues.h ¶ + fail.h ¶ + gc.h ¶ major_gc.h ¶ freelist.h ¶ memory.h ¶ - gc.h ¶ minor_gc.h ¶ prims.h @@ -444,7 +445,8 @@ freelist.h ¶ minor_gc.h ¶ roots.h ¶ - signals.h + signals.h ¶ + sys.h "stacks.c.x" Ä stacks.c ¶ config.h ¶ @@ -916,10 +918,11 @@ config.h ¶ ::config:sm-Mac.h ¶ mlvalues.h ¶ + fail.h ¶ + gc.h ¶ major_gc.h ¶ freelist.h ¶ memory.h ¶ - gc.h ¶ minor_gc.h ¶ prims.h @@ -980,7 +983,8 @@ freelist.h ¶ minor_gc.h ¶ roots.h ¶ - signals.h + signals.h ¶ + sys.h "stacks.c.o" Ä stacks.c ¶ config.h ¶ diff --git a/byterun/floats.c b/byterun/floats.c index 63ef4e925..939b56d93 100644 --- a/byterun/floats.c +++ b/byterun/floats.c @@ -5,7 +5,7 @@ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ -/* Automatique. Distributed only by permission. */ +/* en Automatique. Distributed only by permission. */ /* */ /***********************************************************************/ @@ -189,7 +189,7 @@ value log10_float(value f) /* ML */ value modf_float(value f) /* ML */ { -#if macintosh +#if __MRC__ || __SC__ _float_eval frem; #else double frem; diff --git a/byterun/interp.a b/byterun/interp.a index d4b1e5771..0dd7fc3b5 100644 --- a/byterun/interp.a +++ b/byterun/interp.a @@ -5,7 +5,7 @@ * Damien Doligez, Projet Para, INRIA Rocquencourt */ * */ * Copyright 1996 Institut National de Recherche en Informatique et */ -* Automatique. Distributed only by permission. */ +* en Automatique. Distributed only by permission. */ * */ ***********************************************************************/ @@ -13,9 +13,33 @@ * The bytecode interpreter in 68000 assembly language */ -; print push,off -; include 'Types.a' ; pour _Debugger -; print pop + GBLA &debugging +&debugging SETA 1 + + IF &debugging THEN + print push,off + include 'Types.a' + print pop + + macro + Debug_count + SUBQ.L #1, (debug_i_counter).L + BNE.S @nobreak + _Debugger +@nobreak: + endm + macro + Debug_stop + _Debugger + endm + ELSE + macro + Debug_count + endm + macro + Debug_stop + endm + ENDIF string asis print nopage @@ -43,6 +67,7 @@ import (thread_code): code import (instr_table, instr_base): data import (callback_depth): data + import (debug_i_counter): data ;XXX msg record dc.b 'Fatal error in interp: bad opcode (%lx)', $0D, $00 @@ -66,7 +91,7 @@ extra_args_ equ D7 ; initial_sp_offset_ equ -$44 ; initial_external_raise_ equ -$48 ; initial_local_roots_ equ -$4C -; initial_callback_depth_ equ -$50 +; (slot vide) equ -$50 (was: initial_callback_depth_) ; pile: relatif a A7 local_var_size_ equ $50 @@ -74,7 +99,7 @@ raise_buf_ equ $10 initial_sp_offset_ equ $0C initial_external_raise_ equ $08 initial_local_roots_ equ $04 -initial_callback_depth_ equ $00 +;(slot vide) equ $00 ; temporaires: A0 A1 D0 D3 D4 D5 (D3, D4, D5 sont callee-save) ; stack: A7 @@ -89,7 +114,7 @@ initial_callback_depth_ equ $00 MOVE.L y_ptr_reg, (young_ptr).L MOVE.L y_limit_reg, (young_limit).L endm - + macro Call_restore MOVE.L (young_limit).L, y_limit_reg @@ -98,7 +123,8 @@ initial_callback_depth_ equ $00 endm macro - UDispatch + Udispatch ; Dispatch, no spacer + Debug_count MOVE.L (pc_)+, D0 JMP (jtbl_, D0.W) endm @@ -106,6 +132,7 @@ initial_callback_depth_ equ $00 ; L'interprete commence ici. + Debug_stop MOVEM.L D3-D7/A2-A6,-(A7) ; 10 registres LEA.L -local_var_size_(A7), A7 Call_restore @@ -119,10 +146,10 @@ initial_callback_depth_ equ $00 Call_setup ; 2eme copie: "lbl_1B88" LEA.L local_var_size_(A7), A7 MOVEM.L (A7)+, D3-D7/A2-A6 - RTS + RTS noinit: MOVEA.L local_var_size_+4*10+$4(A7), A0 ; code - CMPI.L #124, (A0) + CMPI.L #133, (A0) BHI.S nothread ; deja tresse MOVE.L local_var_size_+4*10+$8(A7), -(A7) ; argument 1 (size) @@ -132,14 +159,14 @@ noinit: MOVEA.L local_var_size_+4*10+$4(A7), A0 ; code Call_restore LEA.L $8(A7), A7 -nothread: LEA.L i_start(PC), A6 - ADDA.L #$8000, A6 +nothread: LEA.L i_start(PC), jtbl_ + ADDA.L #$8000, jtbl_ MOVE.L (local_roots).L, initial_local_roots_(A7) MOVE.L (stack_high).L, D0 SUB.L (extern_sp).L, D0 MOVE.L D0, initial_sp_offset_(A7) MOVE.L (external_raise).L, initial_external_raise_(A7) - MOVE.L (callback_depth).L, initial_callback_depth_(A7) + ADDQ.L #1, (callback_depth).L PEA.L raise_buf_(A7) Call_setup JSR (__setjmp).L @@ -148,9 +175,8 @@ nothread: LEA.L i_start(PC), A6 TST.L D0 BEQ.S lbl_78 ; endif MOVE.L initial_local_roots_(A7), (local_roots).L - MOVE.L initial_callback_depth_(A7), (callback_depth).L MOVEA.L (exn_bucket).L, accu_ - JMP i_82-i_base(A6) ; RAISE + JMP i_91-i_base(jtbl_) ; RAISE lbl_78: LEA.L raise_buf_(A7), A0 MOVE.L A0, (external_raise).L MOVEA.L (extern_sp).L, sp_ @@ -158,19 +184,18 @@ lbl_78: LEA.L raise_buf_(A7), A0 CLR.L extra_args_ LEA.L (atom_table+4).L, env_ MOVEA.W #1, accu_ - UDispatch + Udispatch ; Table pour thread_code macro Make_table lcla &i &i seta 0 - while &i < 124 do + while &i < 133 do DC.L i_&i - i_base &i seta &i + 1 endw endm - table: Make_table ; Remplissage @@ -205,16 +230,16 @@ table: Make_table endm macro - Dispatch - UDispatch + Dispatch ; Dispatch and spacer + Udispatch Spacer 16 - BRA fatal + BRA.W fatal endm macro - Nodispatch + Nodispatch ; spacer without dispatch Spacer 16 - BRA fatal + BRA.W fatal endm ; 64k dans lesquels on branche directement. @@ -227,6 +252,8 @@ fatal: MOVE.L -4(pc_), -(A7) JSR (fatal_error_arg).L ; Call_restore never reached ; ADDQ.L #8, A7 + Spacer 256 + Nodispatch macro ACC &n @@ -422,7 +449,8 @@ i_38: APPTERM 2 i_39: APPTERM 3 ; RETURN -i_40: MOVE.L (pc_), D0 +i_40: Debug_stop + MOVE.L (pc_), D0 ASL.L #2, D0 ADD.L D0, sp_ TST.L extra_args_ @@ -430,7 +458,7 @@ i_40: MOVE.L (pc_), D0 SUBQ.L #1, extra_args_ MOVEA.L (accu_), pc_ MOVEA.L accu_, env_ - UDispatch + Udispatch lbl_562: MOVEA.L (sp_)+, pc_ MOVEA.L (sp_)+, env_ MOVE.L (sp_)+, extra_args_ @@ -466,11 +494,11 @@ lbl_5B6: SUBQ.L #4, D0 MOVEA.L (sp_)+, env_ endm -; Alloc_small [#],size, [#],tag +; Alloc_small [#],size, [#],tag, result ; entree: size = taille en octets AVEC HEADER ; tag = la valeur du tag + $0300 +; result = registre d'adresse ou mettre le resultat ; '#' indique un immediat, (vide) indique un registre -; sortie dans &result, qui doit etre un registre d'adresse. ; Tous les registres sont preserves sauf A0, A1, D0 ; &size et &tag sont ecrases si ce sont des registres @@ -509,16 +537,16 @@ lbl_5B6: SUBQ.L #4, D0 ORI.W #(&size-4) << 8, &tag MOVE.L &tag, (&result)+ else - MOVEI.L #((&size-4)<<8) + &tag, (&result)+ + MOVE.L #((&size-4)<<8) + &tag, (&result)+ endif endm ; GRAB i_42: MOVE.L (pc_)+, D3 ; D3 = required CMP.L extra_args_, D3 - BGT i_42x + BGT.S i_42x SUB.L D3, extra_args_ - UDispatch + Udispatch i_42x: MOVE.L extra_args_, D4 ; extra_args_ = num_args ADDQ.L #4, D4 LSL.L #2, D4 @@ -549,50 +577,120 @@ lbl_6C8: MOVE.L D5, D0 ADD.L pc_, D0 MOVEA.L accu_, A0 MOVE.L D0, (A0)+ + ADDQ.L #4, pc_ BRA.S lbl_766 lbl_746: MOVE.L (sp_)+, (A0)+ lbl_766: SUBQ.L #1, D5 BPL.S lbl_746 - ADDQ.L #4, pc_ Dispatch ; CLOSUREREC -i_44: MOVE.L (pc_)+, D5 +i_44: MOVE.L (pc_)+, D4 + MOVE.L (pc_)+, D5 BLE.S lbl_792 MOVE.L accu_, -(sp_) -lbl_792: MOVE.L D5, D0 - ADDQ.L #3, D0 +lbl_792: MOVE.L D4, D0 + ASL.L #1, D0 + ADD.L D5, D0 ASL.L #2, D0 Alloc_small ,D0, #,$3FA, accu_ MOVEA.L accu_, A0 + MOVE.L D4, D0 + ASL.L #3, D0 + SUBQ.L #4, D0 + ADDA.L D0, A0 + MOVE.L D5, D0 + BRA.S lbl_800 +lbl_799: MOVE.L (sp_)+, (A0)+ +lbl_800: SUBQ.L #1, D0 + BPL.S lbl_799 + MOVE.L accu_, A0 MOVE.L (pc_), D0 ASL.L #2, D0 ADD.L pc_, D0 MOVE.L D0, (A0)+ + MOVE.L accu_, -(sp_) MOVEQ.L #1, D0 - MOVE.L D0, (A0)+ BRA.S lbl_838 -lbl_818: MOVE.L (sp_)+, (A0)+ -lbl_838: SUBQ.L #1, D5 - BPL.S lbl_818 - MOVE.L accu_, -(A7) - PEA.L 4(accu_) - Call_setup - JSR (modify).L - Call_restore - ADDQ.L #8, A7 - ADDQ.L #4, pc_ +lbl_818: MOVE.L D0, D1 + ASL.L #8, D1 + ASL.L #3, D1 + ADD.W #$3F9, D1 + MOVE.L D1, (A0)+ + MOVE.L D0, D1 + ASL.L #2, D1 + MOVE.L (pc_, D1), D1 + ADD.L pc_, D1 + MOVE.L D1, (A0)+ + ADDQ.L #1, D0 +lbl_838: CMP.L D4, D0 + BMI.S lbl_818 + ASL.L #2, D4 + ADDA.L D4, pc_ + Dispatch + +; OFFSETCLOSUREM2 +i_45: Debug_stop + MOVE.L env_, accu_ + SUBQ.L #8, accu_ + Dispatch + +; OFFSETCLOSURE0 +i_46: Debug_stop + MOVE.L env_, accu_ + Dispatch + +; OFFSETCLOSURE2 +i_47: Debug_stop + MOVE.L env_, accu_ + ADDQ.L #8, accu_ + Dispatch + +; OFFSETCLOSURE +i_48: Debug_stop + MOVE.L (pc_)+, D0 + ASL.L #2, D0 + ADD.L env_, D0 + MOVE.L D0, accu_ + Dispatch + +; PUSHOFFSETCLOSUREM2 +i_49: Debug_stop + MOVE.L accu_, -(sp_) + MOVE.L env_, accu_ + SUBQ.L #8, accu_ + Dispatch + +; PUSHOFFSETCLOSURE0 +i_50: MOVE.L accu_, -(sp_) + MOVE.L env_, accu_ + Dispatch + +; PUSHOFFSETCLOSURE2 +i_51: Debug_stop + MOVE.L accu_, -(sp_) + MOVE.L env_, accu_ + ADDQ.L #8, accu_ + Dispatch + +; PUSHOFFSETCLOSURE +i_52: Debug_stop + MOVE.L accu_, -(sp_) + MOVE.L (pc_)+, D0 + ASL.L #2, D0 + ADD.L env_, D0 + MOVE.L D0, accu_ Dispatch ; GETGLOBAL -i_45: MOVE.L (pc_)+, D0 +i_53: MOVE.L (pc_)+, D0 ASL.L #2, D0 MOVEA.L (global_data).L, A0 MOVEA.L (A0, D0.L), accu_ Dispatch ; PUSHGETGLOBAL -i_46: MOVE.L accu_, -(sp_) +i_54: MOVE.L accu_, -(sp_) MOVE.L (pc_)+, D0 ASL.L #2,D0 MOVEA.L (global_data).L, A0 @@ -600,7 +698,7 @@ i_46: MOVE.L accu_, -(sp_) Dispatch ; GETGLOBALFIELD -i_47: MOVE.L (pc_)+, D0 +i_55: MOVE.L (pc_)+, D0 ASL.L #2, D0 MOVEA.L (global_data).L, A0 MOVEA.L (A0, D0.L), A0 @@ -610,7 +708,7 @@ i_47: MOVE.L (pc_)+, D0 Dispatch ; PUSHGETGLOBALFIELD -i_48: MOVE.L accu_, -(sp_) +i_56: MOVE.L accu_, -(sp_) MOVE.L (pc_)+, D0 ASL.L #2, D0 MOVEA.L (global_data).L, A0 @@ -621,7 +719,7 @@ i_48: MOVE.L accu_, -(sp_) Dispatch ; SETGLOBAL -i_49: MOVE.L accu_, -(A7) +i_57: MOVE.L accu_, -(A7) MOVE.L (pc_)+, D0 ASL.L #2,D0 MOVEA.L (global_data).L, A0 @@ -634,23 +732,23 @@ i_49: MOVE.L accu_, -(A7) Dispatch ; ATOM0 -i_50: LEA.L (atom_table+4).L, accu_ +i_58: LEA.L (atom_table+4).L, accu_ Dispatch ; ATOM -i_51: MOVE.L (pc_)+, D0 +i_59: MOVE.L (pc_)+, D0 ASL.L #2, D0 LEA.L (atom_table+4).L, accu_ ADDA.L D0, accu_ Dispatch ; PUSHATOM0 -i_52: MOVE.L accu_, -(sp_) +i_60: MOVE.L accu_, -(sp_) LEA.L (atom_table+4).L, accu_ Dispatch ; PUSHATOM -i_53: MOVE.L accu_, -(sp_) +i_61: MOVE.L accu_, -(sp_) MOVE.L (pc_)+, D0 ASL.L #2, D0 LEA.L (atom_table+4).L, accu_ @@ -658,7 +756,7 @@ i_53: MOVE.L accu_, -(sp_) Dispatch ; MAKEBLOCK -i_54: MOVE.L (pc_)+, D4 ; wosize = D4 +i_62: MOVE.L (pc_)+, D4 ; wosize = D4 MOVE.L (pc_)+, D3 ; tag = D3 ORI.W #$0300, D3 MOVE.L D4, D0 @@ -690,9 +788,27 @@ lbl_A62: SUBQ.L #1, D4 Dispatch endm -i_55: MAKEBLOCK 1 -i_56: MAKEBLOCK 2 -i_57: MAKEBLOCK 3 +i_63: MAKEBLOCK 1 +i_64: MAKEBLOCK 2 +i_65: MAKEBLOCK 3 + +; MAKEFLOATBLOCK +i_66: MOVE.L (pc_)+, D5 + MOVE.L D5, D0 + ASL.L #3, D0 + Alloc_small ,D0, #,$3FE, A0 + MOVE.L A0, A1 + MOVE.L (accu_)+, (A1)+ + MOVE.L (accu_)+, (A1)+ + MOVEQ.L #1, D0 + BRA.S lbl_66a +lbl_66b: MOVE.L (sp_)+, (A1)+ + MOVE.L (sp_)+, (A1)+ + ADDQ.L #1, D0 +lbl_66a: CMP.L D5, D0 + BMI.S lbl_66b + MOVEA.L A0, accu_ + Dispatch macro GETFIELD &n @@ -700,19 +816,29 @@ i_57: MAKEBLOCK 3 Dispatch endm -i_58: GETFIELD 0 -i_59: GETFIELD 1 -i_60: GETFIELD 2 -i_61: GETFIELD 3 +i_67: GETFIELD 0 +i_68: GETFIELD 1 +i_69: GETFIELD 2 +i_70: GETFIELD 3 ; GETFIELD -i_62: MOVE.L (pc_)+, D0 +i_71: MOVE.L (pc_)+, D0 ASL.L #2, D0 MOVEA.L (accu_, D0.L), accu_ Dispatch +; GETFLOATFIELD +i_72: Debug_stop + Alloc_small #,8, #,$3FD, A0 + MOVE.L (pc_)+, D0 + ASL.L #3, D0 + MOVE.L (accu_, D0), (A0) + MOVE.L 4(accu_, D0), 4(A0) + MOVEA.L A0, accu_ + Dispatch + ; SETFIELD0 -i_63: MOVEA.L accu_, A1 ; A1 = modify_dest +i_73: MOVEA.L accu_, A1 ; A1 = modify_dest ; modify_newval = *sp++ BRA lbl_mod Nodispatch @@ -725,67 +851,50 @@ i_63: MOVEA.L accu_, A1 ; A1 = modify_dest Nodispatch endm -i_64: SETFIELD 1 -i_65: SETFIELD 2 -i_66: SETFIELD 3 +i_74: SETFIELD 1 +i_75: SETFIELD 2 +i_76: SETFIELD 3 ; SETFIELD -i_67: MOVE.L (pc_)+, D0 +i_77: MOVE.L (pc_)+, D0 ASL.L #$2, D0 LEA.L (accu_, D0.L), A1 ; A1 = modify_dest ; modify_newval = *sp++ BRA lbl_mod Nodispatch -; DUMMY -i_68: MOVE.L (pc_)+, D3 - ASL.L #2, D3 - MOVE.L D3, D0 - ADDQ.L #4, D0 - Alloc_small ,D0 ,#,$300, accu_ - MOVEQ.L #1, D0 - BRA.S lbl_E28 -lbl_E1A: MOVE.L D0, (accu_, D3.L) -lbl_E28: SUBQ.L #4, D3 - BPL.S lbl_E1A +; SETFLOATFIELD +i_78: Debug_stop + MOVEA.L (sp_)+, A0 + MOVE.L (pc_)+, D0 + ASL.L #3, D0 + ADDA.L D0, accu_ + MOVE.L (A0)+, (accu_)+ + MOVE.L (A0)+, (accu_)+ + MOVEA.W #1, accu_ Dispatch -; UPDATE -i_69: MOVEA.L (sp_)+, A1 - MOVE.L -4(A1), D5 - LSR.L #8, D5 - LSR.L #2, D5 - ASL.L #2, D5 - MOVE.B -1(A1), -1(accu_) - BRA.S lbl_E7E -lbl_E5C: MOVE.L (A1, D5.L), -(A7) - PEA.L (accu_, D5.L) - Call_setup - JSR (modify).L - Call_restore - ADDQ.L #8, A7 -lbl_E7E: SUBQ.L #4, D5 - BPL.S lbl_E5C - BRA i_90 - Nodispatch - ; VECTLENGTH -i_70: MOVE.L -4(accu_), D0 +i_79: Debug_stop + MOVE.L -4(accu_), D0 LSR.L #8, D0 LSR.L #1, D0 - ORI.B #1, D0 + CMP.B #$FE, -1(accu_) + BNE.S lbl_79a + LSR.L #1, D0 +lbl_79a: ORI.B #1, D0 MOVEA.L D0, accu_ Dispatch ; GETVECTITEM -i_71: MOVE.L (sp_)+, D0 +i_80: MOVE.L (sp_)+, D0 ASR.L #1, D0 ASL.L #2, D0 MOVEA.L (accu_, D0.L), accu_ Dispatch ; SETVECTITEM -i_72: MOVE.L (sp_)+, D0 +i_81: MOVE.L (sp_)+, D0 ASR.L #1, D0 ASL.L #2, D0 LEA.L (accu_, D0.L), A1 ; A1 = modify_dest @@ -794,7 +903,7 @@ i_72: MOVE.L (sp_)+, D0 Nodispatch ; GETSTRINGCHAR -i_73: MOVE.L (sp_)+, D3 +i_82: MOVE.L (sp_)+, D3 ASR.L #1, D3 CLR.L D0 MOVE.B (accu_, D3.L), D0 @@ -804,7 +913,7 @@ i_73: MOVE.L (sp_)+, D3 Dispatch ; SETSTRINGCHAR -i_74: MOVE.L (sp_)+, D0 +i_83: MOVE.L (sp_)+, D0 ASR.L #1, D0 MOVE.L (sp_)+, D3 ASR.L #1, D3 @@ -813,25 +922,26 @@ i_74: MOVE.L (sp_)+, D0 Dispatch ; BRANCH -i_75: MOVE.L (pc_), D0 +i_BRANCH: +i_84: MOVE.L (pc_), D0 ASL.L #2, D0 ADD.L D0, pc_ Dispatch ; BRANCHIF -i_76: CMPA.W #1, accu_ - BNE i_75 +i_85: CMPA.W #1, accu_ + BNE.S i_BRANCH ADDQ.L #4, pc_ Dispatch ; BRANCHIFNOT -i_77: CMPA.W #1, accu_ - BEQ i_75 +i_86: CMPA.W #1, accu_ + BEQ.S i_BRANCH ADDQ.L #4, pc_ Dispatch ; SWITCH -i_78: CLR.L D5 +i_87: CLR.L D5 MOVE.W (pc_)+, D5 CLR.L D3 MOVE.W (pc_)+, D3 @@ -845,7 +955,7 @@ i_78: CLR.L D5 MOVE.L (pc_, D3.L), D0 ASL.L #2, D0 ADD.L D0, pc_ - UDispatch + Udispatch lbl_F9C: MOVE.L accu_, D0 ASR.L #1, D0 CMP.L D0, D3 @@ -854,20 +964,20 @@ lbl_F9C: MOVE.L accu_, D0 MOVE.L (pc_, D0.L), D0 ASL.L #2, D0 ADD.L D0, pc_ - UDispatch + Udispatch lbl_FC6: ADD.L D5, D3 LSL.L #2, D3 ADDA.L D3, pc_ Dispatch ; BOOLNOT -i_79: MOVEQ #4, D0 +i_88: MOVEQ #4, D0 SUB.L accu_, D0 MOVEA.L D0, accu_ Dispatch ; PUSHTRAP -i_80: MOVE.L extra_args_, D0 +i_89: MOVE.L extra_args_, D0 ASL.L #1, D0 ADDQ.L #1, D0 MOVE.L D0, -(sp_) @@ -882,12 +992,13 @@ i_80: MOVE.L extra_args_, D0 Dispatch ; POPTRAP -i_81: MOVE.L 4(sp_), (trapsp).L +i_90: MOVE.L 4(sp_), (trapsp).L LEA.L $10(sp_), sp_ Dispatch ; RAISE XXX debugger stuff not implemented -i_82: MOVEA.L (trapsp).L, sp_ +i_91: Debug_stop + MOVEA.L (trapsp).L, sp_ MOVEA.L (stack_high).L, A0 MOVE.L initial_sp_offset_(A7), D0 SUBA.L D0, A0 @@ -896,6 +1007,7 @@ i_82: MOVEA.L (trapsp).L, sp_ MOVE.L accu_, (exn_bucket).L MOVE.L initial_external_raise_(A7), D3 MOVE.L D3, (external_raise).L + SUBQ.L #1, (callback_depth).L PEA.L (1).W MOVE.L D3, -(A7) Call_setup @@ -910,10 +1022,11 @@ lbl_1080: MOVEA.L (sp_)+, pc_ Dispatch ; CHECK_SIGNALS -i_83: TST.L (something_to_do).L - BNE i_83x - UDispatch -i_83x: CLR.L (something_to_do).L +i_CHECK_SIGNALS: +i_92: TST.L (something_to_do).L + BNE.S i_92a + Udispatch +i_92a: CLR.L (something_to_do).L TST.L (force_major_slice).L BEQ.S lbl_1116 Setup_for_gc @@ -941,7 +1054,7 @@ lbl_1116: MOVE.L (pending_signal).L, D5 CLR.L extra_args_ lbl_1168: TST.L (have_to_interact).L BNE.S interact - UDispatch + Udispatch interact: CLR.L (have_to_interact).L CLR.L -(A7) Call_setup @@ -955,7 +1068,7 @@ interact: CLR.L (have_to_interact).L MOVE.L env_, -(sp_) MOVE.L sp_, (extern_sp).L endm - + macro Restore_after_c_call MOVEA.L (extern_sp).L, sp_ @@ -993,14 +1106,14 @@ interact: CLR.L (have_to_interact).L Dispatch endm -i_84: C_CALL 1 -i_85: C_CALL 2 -i_86: C_CALL 3 -i_87: C_CALL 4 -i_88: C_CALL 5 +i_93: C_CALL 1 +i_94: C_CALL 2 +i_95: C_CALL 3 +i_96: C_CALL 4 +i_97: C_CALL 5 ; C_CALLN -i_89: MOVE.L (pc_)+, D4 +i_98: MOVE.L (pc_)+, D4 MOVE.L accu_, -(sp_) Setup_for_c_call MOVE.L D4, -(A7) @@ -1025,13 +1138,15 @@ i_89: MOVE.L (pc_)+, D4 Dispatch endm -i_90: CONST 0 -i_91: CONST 1 -i_92: CONST 2 -i_93: CONST 3 +i_CONST0: +i_99: CONST 0 +i_CONST1: +i_100: CONST 1 +i_101: CONST 2 +i_102: CONST 3 ; CONSTINT -i_94: MOVEA.L (pc_)+, A0 +i_103: MOVEA.L (pc_)+, A0 LEA.L 1(A0, A0.L), accu_ Dispatch @@ -1041,35 +1156,35 @@ i_94: MOVEA.L (pc_)+, A0 CONST &n endm -i_95: PUSHCONST 0 -i_96: PUSHCONST 1 -i_97: PUSHCONST 2 -i_98: PUSHCONST 3 +i_104: PUSHCONST 0 +i_105: PUSHCONST 1 +i_106: PUSHCONST 2 +i_107: PUSHCONST 3 ; PUSHCONSTINT -i_99: MOVE.L accu_, -(sp_) +i_108: MOVE.L accu_, -(sp_) MOVEA.L (pc_)+, A0 LEA.L 1(A0, A0.L), accu_ Dispatch ; NEGINT -i_100: MOVEQ.L #2, D0 +i_109: MOVEQ.L #2, D0 SUB.L accu_, D0 MOVEA.L D0, accu_ Dispatch ; ADDINT -i_101: ADDA.L (sp_)+, accu_ +i_110: ADDA.L (sp_)+, accu_ SUBQ.L #1, accu_ Dispatch ; SUBINT -i_102: SUBA.L (sp_)+, accu_ +i_111: SUBA.L (sp_)+, accu_ ADDQ.L #1, accu_ Dispatch ; MULINT -i_103: MOVE.L accu_, D0 +i_112: MOVE.L accu_, D0 ASR.L #1, D0 Call_setup MOVE.L (sp_)+, D1 @@ -1103,23 +1218,23 @@ i_103: MOVE.L accu_, D0 Dispatch endm -i_104: DIVMODINT DIV -i_105: DIVMODINT MOD +i_113: DIVMODINT DIV +i_114: DIVMODINT MOD ; ANDINT -i_106: MOVE.L accu_, D0 +i_115: MOVE.L accu_, D0 AND.L (sp_)+, D0 MOVEA.L D0, accu_ Dispatch ; ORINT -i_107: MOVE.L accu_, D0 +i_116: MOVE.L accu_, D0 OR.L (sp_)+, D0 MOVEA.L D0, accu_ Dispatch ; XORINT -i_108: MOVE.L accu_, D0 +i_117: MOVE.L accu_, D0 MOVE.L (sp_)+, D3 EOR.L D3, D0 ADDQ.L #1, D0 @@ -1139,40 +1254,40 @@ i_108: MOVE.L accu_, D0 Dispatch endm -i_109: SHIFTINT LSL -i_110: SHIFTINT LSR -i_111: SHIFTINT ASR +i_118: SHIFTINT LSL +i_119: SHIFTINT LSR +i_120: SHIFTINT ASR macro INT_COMPARE &tst CMPA.L (sp_)+, accu_ - B&tst i_91 + B&tst i_CONST1 MOVEA.W #1, accu_ Dispatch endm -i_112: INT_COMPARE EQ -i_113: INT_COMPARE NE -i_114: INT_COMPARE LT -i_115: INT_COMPARE LE -i_116: INT_COMPARE GT -i_117: INT_COMPARE GE +i_121: INT_COMPARE EQ +i_122: INT_COMPARE NE +i_123: INT_COMPARE LT +i_124: INT_COMPARE LE +i_125: INT_COMPARE GT +i_126: INT_COMPARE GE ; OFFSETINT -i_118: MOVE.L (pc_)+, D0 +i_127: MOVE.L (pc_)+, D0 ASL.L #1, D0 ADDA.L D0, accu_ Dispatch ; OFFSETREF -i_119: MOVE.L (pc_)+, D0 +i_128: MOVE.L (pc_)+, D0 ASL.L #1, D0 ADD.L D0, (accu_) MOVEA.W #1, accu_ Dispatch ; GETMETHOD -i_120: MOVEA.L (sp_), A0 ; sp[0] +i_129: MOVEA.L (sp_), A0 ; sp[0] MOVEA.L (A0), A0 ; Field (sp[0], 0) MOVE.L accu_, D3 MOVEQ #$12, D0 @@ -1185,35 +1300,39 @@ i_120: MOVEA.L (sp_), A0 ; sp[0] Dispatch ; STOP -i_121: MOVE.L initial_external_raise_(A7), (external_raise).L +i_130: Debug_stop + MOVE.L initial_external_raise_(A7), (external_raise).L MOVE.L sp_, (extern_sp).L + SUBQ.L #1, (callback_depth).L MOVE.L accu_, D0 BRA lbl_1B88 Nodispatch ; EVENT XXX pas implemente -i_122: Dispatch +i_131: Dispatch ; BREAK XXX pas implemente -i_123: Dispatch +i_132: Dispatch - Spacer 12100 ; complete a 64k + IF NOT &debugging THEN + Spacer 11762 ; complete a 64k ;XXX + ENDIF BRA fatal lbl_mod: MOVE.L (A1), D5 ; A1 = modify_dest; D5 = _old_ MOVE.L (sp_)+, D4 ; D4 = modify_newval MOVE.L D4, (A1) CMPA.L (heap_start).L, A1 - BCS i_90 + BCS i_CONST0 CMPA.L (heap_end).L, A1 - BCC i_90 + BCC i_CONST0 MOVE.L A1, D3 SUB.L (heap_start).L, D3 ASR.L #8, D3 ASR.L #4, D3 MOVEA.L (page_table).L, A0 TST.B (A0, D3.L) - BEQ i_90 + BEQ i_CONST0 TST.L (gc_phase).L BNE.S lbl_CC2 MOVE.L A1, D3 ; A1 est caller-save @@ -1224,40 +1343,40 @@ lbl_mod: MOVE.L (A1), D5 ; A1 = modify_dest; D5 = _old_ ADDQ.L #4 ,A7 MOVEA.L D3, A1 ; A1 est caller-save lbl_CC2: BTST.L #0, D4 - BNE i_90 + BNE i_CONST0 CMP.L (young_start).L, D4 - BLS i_90 + BLS i_CONST0 CMP.L (young_end).L, D4 - BCC i_90 + BCC i_CONST0 BTST.L #0, D5 BNE.S lbl_D00 CMP.L (young_start).L, D5 BLS.S lbl_D00 CMP.L (young_end).L, D5 - BCS i_90 + BCS i_CONST0 lbl_D00: MOVEA.L (ref_table_ptr).L, A0 MOVE.L A1, (A0)+ MOVE.L A0, (ref_table_ptr).L CMPA.L (ref_table_limit).L, A0 - BCS i_90 + BCS i_CONST0 Call_setup JSR (realloc_ref_table).L Call_restore - BRA i_90 + BRA i_CONST0 chk_stks: CMPA.L (stack_threshold).L, sp_ - BCC i_83 + BCC i_CHECK_SIGNALS MOVE.L sp_, (extern_sp).L Call_setup JSR (realloc_stack).L Call_restore MOVE.L (extern_sp).L, sp_ - BRA i_83 + BRA i_CHECK_SIGNALS lbl_1B88: Call_setup ; 2eme copie: "init" LEA.L local_var_size_(A7), A7 MOVEM.L (A7)+, D3-D7/A2-A6 - RTS + RTS dc.b $80 + 10, 'interprete', 0 dc.w 0 endproc diff --git a/byterun/interp.c b/byterun/interp.c index 8c4881d51..abe1867ed 100644 --- a/byterun/interp.c +++ b/byterun/interp.c @@ -5,7 +5,7 @@ /* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ -/* Automatique. Distributed only by permission. */ +/* en Automatique. Distributed only by permission. */ /* */ /***********************************************************************/ @@ -32,8 +32,7 @@ #if macintosh #include "rotatecursor.h" -extern int volatile have_to_interact; -#endif +#endif /* macintosh */ /* Registers for the abstract machine: pc the code pointer @@ -182,7 +181,7 @@ value interprete(code_t prog, asize_t prog_size) if (prog == NULL) { /* Interpreter is initializing */ #ifdef THREADED_CODE - instr_table = (char **) jumptable; + instr_table = (char **) jumptable; instr_base = Jumptbl_base; #endif return Val_unit; @@ -226,6 +225,7 @@ value interprete(code_t prog, asize_t prog_size) Assert(sp <= stack_high); #endif curr_instr = *pc++; + dispatch_instr: switch(curr_instr) { #endif @@ -516,7 +516,7 @@ value interprete(code_t prog, asize_t prog_size) *--sp = accu; /* fallthrough */ Instruct(OFFSETCLOSURE2): accu = env + 2 * sizeof(value); Next; - + /* Access to global variables */ diff --git a/byterun/macintosh.c b/byterun/macintosh.c index a1c08cbc7..846e8f914 100644 --- a/byterun/macintosh.c +++ b/byterun/macintosh.c @@ -5,7 +5,7 @@ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ -/* Automatique. Distributed only by permission. */ +/* en Automatique. Distributed only by permission. */ /* */ /***********************************************************************/ @@ -15,6 +15,7 @@ #include <CursorCtl.h> #include <Files.h> +#include <IntEnv.h> #include <stdio.h> #include <stdlib.h> #include <Strings.h> @@ -23,9 +24,8 @@ #include <Types.h> /* The user interface defaults to MPW tool. The standalone application - replaces these functions, as well as [main], [InitCursorCtl], - [RotateCursor], [atexit] - (see rotatecursor.c). + overrides the ui_* functions, as well as [main], [InitCursorCtl], + [RotateCursor], [atexit], [getenv], and the terminfo functions. */ void ui_exit (int return_code) @@ -57,6 +57,7 @@ int chdir (char *dir) { WDPBRec pb; int result; + short curdir; pb.ioCompletion = NULL; pb.ioNamePtr = c2pstr (dir); @@ -66,100 +67,66 @@ int chdir (char *dir) result = PBOpenWDSync (&pb); p2cstr ((unsigned char *) dir); if (result != noErr) return -1; - result = SetVol (NULL, pb.ioVRefNum); + curdir = pb.ioVRefNum; + result = SetVol (NULL, curdir); if (result != noErr) return -1; if (prevdir != 0){ - prevdir = 0; pb.ioVRefNum = prevdir; PBCloseWDSync (&pb); } + prevdir = curdir; return 0; } -static char *getfullpathid (short wd, long id); - -static void cat_cp_str (char **cstr, StringPtr pstr) -{ - int l2 = (unsigned char) pstr [0]; - int l1 = strlen (*cstr); - int i; - - *cstr = realloc (*cstr, l1 + l2); - if (*cstr == NULL) return; - for (i = 0; i < l2; i++){ - (*cstr)[l1 + i] = pstr [i + 1]; - } - (*cstr)[l1 + l2] = '\0'; -} - -static char *getfullpathpb (CInfoPBPtr pb) +Handle macos_getfullpathname (short vrefnum, long dirid) { - char *result; - - if (pb->hFileInfo.ioFlParID == fsRtParID){ - result = malloc (1); - if (result == NULL) return NULL; - result [0] = '\0'; - }else{ - result = getfullpathid (pb->hFileInfo.ioVRefNum, pb->hFileInfo.ioFlParID); - if (result == NULL) return NULL; - } - cat_cp_str (&result, pb->hFileInfo.ioNamePtr); - if (pb->hFileInfo.ioFlAttrib & (1<<4)) cat_cp_str (&result, "\p:"); + Handle result = NewHandle (0); + CInfoPBRec mypb; + Str255 dirname; + OSErr err; + + if (result == NULL) goto failed; + + mypb.dirInfo.ioNamePtr = dirname; + mypb.dirInfo.ioVRefNum = vrefnum; + mypb.dirInfo.ioDrParID = dirid; + mypb.dirInfo.ioFDirIndex = -1; + + do{ + mypb.dirInfo.ioDrDirID = mypb.dirInfo.ioDrParID; + err = PBGetCatInfo (&mypb, false); + if (err) goto failed; + Munger (result, 0, NULL, 0, ":", 1); + Munger (result, 0, NULL, 0, dirname+1, dirname[0]); + /* XXX out of memory ?! */ + }while (mypb.dirInfo.ioDrDirID != fsRtDirID); return result; -} - -static char *getfullpathcwd (void) -{ - CInfoPBRec pb; - Str255 pname; - - pname [0] = 1; - pname [1] = ':'; - - pb.hFileInfo.ioCompletion = NULL; - pb.hFileInfo.ioVRefNum = 0; - pb.hFileInfo.ioNamePtr = pname; - pb.hFileInfo.ioFRefNum = 0; - pb.hFileInfo.ioFVersNum = 0; - pb.hFileInfo.ioFDirIndex = 0; - pb.hFileInfo.ioDirID = 0; - if (PBGetCatInfoSync (&pb) != noErr) return NULL; - pb.hFileInfo.ioFDirIndex = -1; - if (PBGetCatInfoSync (&pb) != noErr) return NULL; - return getfullpathpb (&pb); -} -static char *getfullpathid (short wd, long id) -{ - CInfoPBRec pb; - Str255 name; - - pb.hFileInfo.ioCompletion = NULL; - pb.hFileInfo.ioNamePtr = name; - pb.hFileInfo.ioVRefNum = wd; - pb.hFileInfo.ioFRefNum = 0; - pb.hFileInfo.ioFVersNum = 0; - pb.hFileInfo.ioFDirIndex = -1; - pb.hFileInfo.ioDirID = id; - if (PBGetCatInfoSync (&pb) != noErr) return NULL; - return getfullpathpb (&pb); + failed: + if (result != NULL) DisposeHandle (result); + return NULL; } char *getcwd (char *buf, long size) { - char *path = getfullpathcwd (); + size_t len; + Handle path = macos_getfullpathname (0, 0); if (path == NULL) return NULL; - if (strlen (path) >= size){ - free (path); + + len = GetHandleSize (path); + + if (len+1 >= size){ + DisposeHandle (path); return NULL; } if (buf == NULL){ - return path; + buf = malloc (len+1); + if (buf == NULL) return NULL; } - strcpy (buf, path); - free (path); + memcpy (buf, *path, len); + buf [len] = '\000'; + DisposeHandle (path); return buf; } @@ -167,7 +134,9 @@ int system (char const *cmd) { char *filename; FILE *f; - + + if (StandAlone) return -1; + filename = getenv ("ocamlcommands"); if (filename == NULL) return 1; f = fopen (filename, "a"); diff --git a/byterun/main.c b/byterun/main.c index de6424a39..39f1118e7 100644 --- a/byterun/main.c +++ b/byterun/main.c @@ -5,7 +5,7 @@ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ -/* Automatique. Distributed only by permission. */ +/* en Automatique. Distributed only by permission. */ /* */ /***********************************************************************/ @@ -27,7 +27,6 @@ extern void expand_command_line (int *, char ***); #if macintosh #include "rotatecursor.h" #include "signals.h" -int volatile have_to_interact = 0; #endif int main(int argc, char **argv) @@ -36,8 +35,8 @@ int main(int argc, char **argv) expand_command_line(&argc, &argv); #endif #if macintosh - rotatecursor_init (&something_to_do, &have_to_interact); -#endif + rotatecursor_init (&something_to_do); +#endif /* macintosh */ caml_main(argv); sys_exit(Val_int(0)); return 0; /* not reached */ diff --git a/byterun/rotatecursor.c b/byterun/rotatecursor.c index 36715b567..ad75c24c7 100644 --- a/byterun/rotatecursor.c +++ b/byterun/rotatecursor.c @@ -5,7 +5,7 @@ /* Damien Doligez, projet Para, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ -/* Automatique. Distributed only by permission. */ +/* en Automatique. Distributed only by permission. */ /* */ /***********************************************************************/ @@ -20,6 +20,8 @@ #include "rotatecursor.h" +int volatile have_to_interact; + typedef struct { TMTask t; int volatile *p1; @@ -44,9 +46,9 @@ extern Xtmtask *getparam() ONEWORDINLINE(0x2009); /* MOVE.L A1, D0 */ static void mytimerproc (void) { register Xtmtask *p = getparam (); - - if (p->p1 != NULL && *(p->p1) == 0) *(p->p1) = 1; - if (p->p2 != NULL && *(p->p2) == 0) *(p->p2) = 1; + + if (p->p1 != NULL) *(p->p1) = 1; + if (p->p2 != NULL) *(p->p2) = 1; } #endif /* GENERATINGCFM */ @@ -57,14 +59,14 @@ static void remove_task (void) RmvTime ((QElemPtr) &mytmtask); } -void rotatecursor_init (int volatile *p1, int volatile *p2) +void rotatecursor_init (int volatile *p1) { InitCursorCtl (NULL); mytmtask.t.tmAddr = NewTimerProc (mytimerproc); mytmtask.t.tmWakeUp = 0; mytmtask.t.tmReserved = 0; mytmtask.p1 = p1; - mytmtask.p2 = p2; + mytmtask.p2 = &have_to_interact; InsTime ((QElemPtr) &mytmtask); PrimeTime ((QElemPtr) &mytmtask, 1); atexit (remove_task); diff --git a/byterun/rotatecursor.h b/byterun/rotatecursor.h index c15226e8d..8951c418d 100644 --- a/byterun/rotatecursor.h +++ b/byterun/rotatecursor.h @@ -16,10 +16,14 @@ #ifndef _rotatecursor_ #define _rotatecursor_ -/* [*p1] and [*p2] will be set to 1 when the time comes to call - [ui_periodic_action]. If p1 or p2 is not used, pass it as NULL. +/* [have_to_interact] will be magically set to 1 when the time comes to + call [rotatecursor_action]. */ +extern int volatile have_to_interact; + +/* [*p1] and [have_to_interact] will be set to 1 when the time comes to + call [rotatecursor_action]. If p1 is not used, pass it as NULL. */ -void rotatecursor_init (int volatile *p1, int volatile *p2); +void rotatecursor_init (int volatile *p1); /* [reverse] is 0 to rotate the cursor clockwise, anything else to rotate counterclockwise. This function always returns 0. diff --git a/byterun/startup.c b/byterun/startup.c index acb069ca5..6596f7d22 100644 --- a/byterun/startup.c +++ b/byterun/startup.c @@ -5,7 +5,7 @@ /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */ /* */ /* Copyright 1996 Institut National de Recherche en Informatique et */ -/* Automatique. Distributed only by permission. */ +/* en Automatique. Distributed only by permission. */ /* */ /***********************************************************************/ @@ -47,6 +47,7 @@ #endif header_t atom_table[256]; +long debug_i_counter = 0; /*XXX*/ /* Initialize the atom table */ @@ -130,15 +131,15 @@ static void check_primitives(int fd, int prim_size) stat_free(prims); } -/* Invocation of camlrun: 4 cases. +/* Invocation of ocamlrun: 4 cases. 1. runtime + bytecode - user types: camlrun [options] bytecode args... - arguments: camlrun [options] bytecode args... + user types: ocamlrun [options] bytecode args... + arguments: ocamlrun [options] bytecode args... 2. bytecode script user types: bytecode args... - 2a (kernel 1) arguments: camlrun ./bytecode args... + 2a (kernel 1) arguments: ocamlrun ./bytecode args... 2b (kernel 2) arguments: bytecode bytecode args... 3. concatenated runtime and bytecode @@ -148,7 +149,7 @@ static void check_primitives(int fd, int prim_size) Algorithm: 1- If argument 0 is a valid byte-code file that does not start with #!, then we are in case 3 and we pass the same command line to the - Caml Light program. + Objective Caml program. 2- In all other cases, we parse the command line as: (whatever) [options] bytecode args... and we strip "(whatever) [options]" from the command line. @@ -342,4 +343,4 @@ void caml_startup_code(code_t code, asize_t code_size, char *data, char **argv) fatal_uncaught_exception(exn_bucket); } } - + diff --git a/byterun/terminfo.c b/byterun/terminfo.c index c535ed87e..c8324be6b 100644 --- a/byterun/terminfo.c +++ b/byterun/terminfo.c @@ -99,9 +99,9 @@ value terminfo_resume (value lines) /* ML */ return Val_unit; } -#else +#else /* HAS_TERMCAP */ -value terminfo_setup (value unit) +value terminfo_setup (value vchan) { return Bad_term; } @@ -124,4 +124,4 @@ value terminfo_resume (value lines) return Val_unit; } -#endif +#endif /* HAS_TERMCAP */ diff --git a/config/config.Mac b/config/config.Mac index 678af8236..695ef4b21 100644 --- a/config/config.Mac +++ b/config/config.Mac @@ -2,15 +2,30 @@ ########## General configuration -### Where to install the binaries +### Where to install the MPW tool binaries set -e BINDIR "{mpw}User Commands:" -### Where to install the standard library +### Where to install the standard library for MPW tools set -e LIBDIR "{mpw}User Commands:ocaml-lib:" ### Where to install the help file set -e HELPFILE "{mpw}O'Caml.help" +### Where to install the application and the standard library +set -e APPLIDIR "{mpw}:O'Caml:" + + +############# Configuration for the contributed libraries + +### Which libraries to compile and install +# Currently available: +# str Regular expressions and high-level string processing +# num Arbitrary-precision rational arithmetic +# dynlink Dynamic linking of bytecode +# graph Graphics (for the standalone application only) +# +set -e OTHERLIBRARIES "num str dynlink graph" + ############# Configuration for the native-code compiler # (not used) @@ -21,12 +36,11 @@ set -e SYSTEM unknown set -e NATIVECC MrC -############# Configuration for the contributed libraries +############# Version numbers (do not change) -### Which libraries to compile and install -# Currently available: -# str Regular expressions and high-level string processing -# num Arbitrary-precision rational arithmetic -# dynlink Dynamic linking of bytecode -# -set -e OTHERLIBRARIES "num str dynlink" +set -e OCAMLMAJOR 2 +set -e OCAMLMINOR 00 +set -e MAJOR 1 +set -e MINOR 0 +set -e STAGE a +set -e REV 1 diff --git a/maccaml/.cvsignore b/maccaml/.cvsignore new file mode 100644 index 000000000..526a7806f --- /dev/null +++ b/maccaml/.cvsignore @@ -0,0 +1,8 @@ +stdlib +*.c.x +primitives +prims.c +Objective*Caml +OCaml.68k +OCaml.PPC +OCaml.bytecode diff --git a/maccaml/Makefile.Mac b/maccaml/Makefile.Mac new file mode 100644 index 000000000..f9137d9fc --- /dev/null +++ b/maccaml/Makefile.Mac @@ -0,0 +1,92 @@ +OCAMLVNUM = {OCAMLMAJOR}{OCAMLMINOR} +MACVNUM = 0x{MAJOR}{MINOR} +VERSIONSTR = "¶"{OCAMLMAJOR}.{OCAMLMINOR}/Mac{MAJOR}.{MINOR}{STAGE}{REV}¶"" + +C = sc +COptions = -I ::byterun: -model far -w 17 +LinkOptions = -model far -compact -pad 0 -state nouse -br 68k -msg nodup +SysLibs = "{libraries}IntEnv.far.o" "{libraries}MacRuntime.o" ¶ + "{clibraries}StdCLib.far.o" "{libraries}MathLib.far.o" ¶ + "{libraries}Interface.o" +CamlrunLibs = ::byterun:libcamlrun.o +WELibs = :WASTE-1.2:WASTELib.o +Libs = {camlrunlibs} {welibs} {syslibs} + +PPCC = mrc -proto strict -sym on # XXX +PPCCOptions = -I ::byterun: -w 35 -d DEBUG # XXX +PPCLinkOptions = -d -sym on # XXX +PPCSysLibs = "{sharedlibraries}MathLib" "{ppclibraries}PPCCRuntime.o" ¶ + "{sharedlibraries}StdCLib" ¶ + "{ppclibraries}StdCRuntime.o" "{sharedlibraries}InterfaceLib" ¶ + "{sharedlibraries}DragLib" +PPCCamlrunLibs = ::byterun:libcamlrun.x +PPCWELibs = :WASTE-1.2:WASTELib.x +PPCLibs = {ppccamlrunlibs} {ppcwelibs} {ppcsyslibs} + +RezDefs = -d SystemSevenOrLater=1 -d OCAMLVNUM={OCAMLVNUM} ¶ + -d MACVNUM={MACVNUM} -d STAGE={STAGE} -d DEVVNUM={REV} ¶ + -d VERSIONSTR={VERSIONSTR} +RezIncludes = "{rincludes}types.r" "{rincludes}systypes.r" "{rincludes}sound.r" + +OBJS = aboutbox.c.o appleevents.c.o clipboard.c.o ¶ + drag.c.o errors.c.o ¶ + events.c.o files.c.o glue.c.o ¶ + graph.c.o lcontrols.c.o lib.c.o main.c.o memory.c.o ¶ + menus.c.o misc.c.o modalfilter.c.o prefs.c.o prims.c.o ¶ + scroll.c.o windows.c.o + +PPCOBJS = aboutbox.c.x appleevents.c.x clipboard.c.x ¶ + drag.c.x errors.c.x ¶ + events.c.x files.c.x glue.c.x ¶ + graph.c.x lcontrols.c.x lib.c.x main.c.x memory.c.x ¶ + menus.c.x misc.c.x modalfilter.c.x prefs.c.x prims.c.x ¶ + scroll.c.x windows.c.x + +all Ä appli + set status 0 + +primitives Ä ::byterun:primitives graphprims + catenate ::byterun:primitives graphprims >primitives + +prims.c Ä primitives + echo '#include "mlvalues.h"' > prims.c + echo '#include "prims.h"' >> prims.c + streamedit -e '1,$ change "extern value " . "();"' primitives >>prims.c + echo 'c_primitive cprim [] = {' >> prims.c + streamedit -e '1,$ change " " . ","' primitives >> prims.c + echo '0 };' >> prims.c + echo 'char * names_of_cprim [] = {' >> prims.c + streamedit -e '1,$ change " ¶"" . "¶","' primitives >> prims.c + echo '0 };' >> prims.c + +OCaml.68k Ä {OBJS} + ilink -o OCaml.68k {linkoptions} {OBJS} {libs} + +OCaml.PPC Ä {PPCOBJS} + ppclink -o OCaml.PPC {ppclinkoptions} {PPCOBJS} {ppclibs} + rename -y OCaml.PPC.xcoff "Objective Caml.xcoff" # XXX + +OCaml.bytecode Ä primitives ::toplevellib.cma ::toplevel:topmain.cmo ¶ + ::otherlibs:graph:graphics.cma + ::byterun:ocamlrun ::ocamlc -linkall -use_prims primitives ¶ + ::toplevellib.cma ::otherlibs:graph:graphics.cma ::toplevel:topmain.cmo ¶ + -o OCaml.bytecode + mergefragment -c -t Caml OCaml.bytecode + +appli ÄÄ ocaml.r OCaml.bytecode OCaml.PPC OCaml.68k + duplicate -y OCaml.68k "Objective Caml" + rez -a -o "Objective Caml" {RezDefs} {rezincludes} ocaml.r + mergefragment -a OCaml.PPC "Objective Caml" + setfile -t APPL -c Caml -a iB "Objective Caml" + mergefragment OCaml.bytecode "Objective Caml" + +install Ä + duplicate -y "Objective Caml" "{APPLIDIR}" + +clean Ä + delete -i {OBJS} {PPCOBJS} OCaml.68k OCaml.PPC OCaml.bytecode ¶ + "Objective Caml" primitives prims.c + delete -i "Objective Caml.xcoff" "Objective Caml.dbg" # XXX + +depend Ä prims.c + makedepend Å.c > Makefile.Mac.depend diff --git a/maccaml/Makefile.Mac.depend b/maccaml/Makefile.Mac.depend new file mode 100644 index 000000000..bab021c45 --- /dev/null +++ b/maccaml/Makefile.Mac.depend @@ -0,0 +1,196 @@ + +"aboutbox.c.x" Ä aboutbox.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"appleevents.c.x" Ä appleevents.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"clipboard.c.x" Ä clipboard.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"drag.c.x" Ä drag.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"errors.c.x" Ä errors.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"events.c.x" Ä events.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"files.c.x" Ä files.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"glue.c.x" Ä glue.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"graph.c.x" Ä graph.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"lcontrols.c.x" Ä lcontrols.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"lib.c.x" Ä lib.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"main.c.x" Ä main.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"memory.c.x" Ä memory.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"menus.c.x" Ä menus.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"misc.c.x" Ä misc.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"modalfilter.c.x" Ä modalfilter.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"prefs.c.x" Ä prefs.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"prims.c.x" Ä prims.c + +"scroll.c.x" Ä scroll.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"windows.c.x" Ä windows.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + + +"aboutbox.c.o" Ä aboutbox.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"appleevents.c.o" Ä appleevents.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"clipboard.c.o" Ä clipboard.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"drag.c.o" Ä drag.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"errors.c.o" Ä errors.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"events.c.o" Ä events.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"files.c.o" Ä files.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"glue.c.o" Ä glue.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"graph.c.o" Ä graph.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"lcontrols.c.o" Ä lcontrols.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"lib.c.o" Ä lib.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"main.c.o" Ä main.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"memory.c.o" Ä memory.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"menus.c.o" Ä menus.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"misc.c.o" Ä misc.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"modalfilter.c.o" Ä modalfilter.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"prefs.c.o" Ä prefs.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"prims.c.o" Ä prims.c + +"scroll.c.o" Ä scroll.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + +"windows.c.o" Ä windows.c ¶ + main.h ¶ + ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" ¶ + constants.h + diff --git a/maccaml/SHORTCUTS b/maccaml/SHORTCUTS new file mode 100644 index 000000000..b9e2d8d88 --- /dev/null +++ b/maccaml/SHORTCUTS @@ -0,0 +1,9 @@ +option-click on a scrollbar's arrow -> scroll by one pixel + +Enter in the toplevel window -> go to bottom of window and append +a newline + +Drag & drop to the toplevel window -> go to bottom of window and +append the dragged text + +Command-period in the toplevel window -> interrupt O'Caml's computation diff --git a/maccaml/aboutbox.c b/maccaml/aboutbox.c new file mode 100644 index 000000000..5aedcfe01 --- /dev/null +++ b/maccaml/aboutbox.c @@ -0,0 +1,110 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +static WindowPtr aboutbox = NULL; +static UserItemUPP DrawAboutUPP = NULL; + +#define kItemText 2 + +static pascal void DrawAbout (DialogPtr d, short item) +{ + WEHandle we = WinGetWE (d); + + Assert (we != NULL); + WEUpdate (d->visRgn, we); +} + +void OpenAboutBox (void) +{ + OSErr err; + short itemtype; + Handle item; + Rect itemrect; + LongRect lr; + WEHandle we = NULL; + WStatusH st = NULL; + Handle txt = NULL; + TextStyle ts; + + if (DrawAboutUPP == NULL) DrawAboutUPP = NewUserItemProc (DrawAbout); + + if (aboutbox != NULL){ + SelectWindow (aboutbox); + }else{ + aboutbox = GetNewDialog (kDialogAbout, NULL, (WindowPtr) -1L); + if (aboutbox == NULL){ + err = memFullErr; + goto failed; + } + SetPort (aboutbox); + + err = WinAllocStatus (aboutbox); + if (err != noErr) goto failed; + + st = WinGetStatus (aboutbox); + Assert (st != NULL); + (*st)->kind = kWinAbout; + + GetDialogItem (aboutbox, kItemText, &itemtype, &item, &itemrect); + SetDialogItem (aboutbox, kItemText, itemtype, (Handle) DrawAboutUPP, &itemrect); + WERectToLongRect (&itemrect, &lr); + err = WENew (&lr, &lr, 0, &we); + if (err != noErr) goto failed; + + (*st)->we = we; + + GetFNum ("\pGeneva", &ts.tsFont); + ts.tsSize = 10; + err = WESetStyle (weDoFont + weDoSize, &ts, we); + if (err != noErr) goto failed; + + txt = GetResource ('TEXT', kAboutText); + err = ResError (); if (err != noErr){ err = noErr; goto failed; } + DetachResource (txt); + + err = WEUseText (txt, we); + if (err != noErr) goto failed; + err = WECalText (we); + if (err != noErr) goto failed; + + WEFeatureFlag (weFReadOnly, weBitSet, we); + + return; + + failed: + if (txt != NULL) DisposeHandle (txt); + if (we != NULL) WEDispose (we); + if (st != NULL) DisposeHandle ((Handle) st); + if (aboutbox != NULL) DisposeWindow (aboutbox); + aboutbox = NULL; + ErrorAlertGeneric (err); + } +} + +void CloseAboutBox (WindowPtr w) +{ + WStatusH st = WinGetStatus (w); + WEHandle we = WinGetWE (w); + + Assert (w == aboutbox); + + Assert (we != NULL); + WEDispose (we); + Assert (st != NULL); + DisposeHandle ((Handle) st); + Assert (w != NULL); + DisposeDialog (w); + aboutbox = NULL; +} diff --git a/maccaml/appleevents.c b/maccaml/appleevents.c new file mode 100644 index 000000000..7e32348b1 --- /dev/null +++ b/maccaml/appleevents.c @@ -0,0 +1,145 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +static OSErr GotRequiredParams (const AppleEvent *ae) +{ + OSErr err; + DescType type; + Size sz; + + err = AEGetAttributePtr (ae, keyMissedKeywordAttr, typeWildCard, &type, NULL, + 0, &sz); + if (err == errAEDescNotFound) return noErr; + if (err == noErr) return errAEParamMissed; + return err; +} + +static pascal OSErr HandleOpenApplication (const AppleEvent *ae, + AppleEvent *reply, long refCon) +{ +#pragma unused (refCon) + launch_toplevel_requested = 1; + return noErr; +} + +static pascal OSErr HandleQuitApplication (const AppleEvent *ae, + AppleEvent *reply, long refCon) +{ +#pragma unused (refCon) + WindowPtr w = FrontWindow (); + WStatusH st; + int request_interaction = prefs.asksavetop && winToplevel != NULL; + OSErr err; + + while (w != NULL){ + WinUpdateStatus (w); + st = WinGetStatus (w); + if (st != NULL && (*st)->dirty){ + request_interaction = 1; + } + w = GetNextWindow (w); + } + if (request_interaction){ + err = AEInteractWithUser (kAEDefaultTimeout, NULL, ProcessEventUPP); + if (err != noErr) return err; + } + err = DoQuit (); + if (err != noErr) return err; + + return noErr; +} + +static pascal OSErr HandleOpenDocuments (const AppleEvent *ae, + AppleEvent *reply, long refCon) +{ +#pragma unused (refCon) + FSSpec filespec; + AEDescList doclist = {0, NULL}; + OSErr err; + long i, len; + Size sz; + AEKeyword key; + DescType type; + + launch_toplevel_requested = 1; + + err = AEGetParamDesc (ae, keyDirectObject, typeAEList, &doclist); + if (err != noErr) goto failed; + + err = GotRequiredParams (ae); + if (err != noErr) goto failed; + + err = AECountItems (&doclist, &len); + if (err != noErr) goto failed; + + for (i = 1; i <= len; i++){ + err = AEGetNthPtr (&doclist, i, typeFSS, &key, &type, &filespec, + sizeof (filespec), &sz); + if (err != noErr) goto failed; + err = FileOpen (&filespec); + if (err != noErr){ + OSErr err2 = AEInteractWithUser (kAEDefaultTimeout, NULL,ProcessEventUPP); + if (err2 == noErr){ + ErrorAlertCantOpen (filespec.name, err); + }else{ + if (err2 == errAENoUserInteraction) err = err2; + goto failed; + } + } + } + AEDisposeDesc (&doclist); + return noErr; + + failed: + if (doclist.dataHandle != NULL) AEDisposeDesc (&doclist); + return err; +} + +static pascal OSErr HandlePrintDocuments (const AppleEvent *ae, + AppleEvent *reply, long refCon) +{ +#pragma unused (refCon) + return errAEEventNotHandled; /* XXX */ +} + +OSErr InstallAEHandlers (void) +{ + OSErr err; + + err = AEInstallEventHandler (kCoreEventClass, kAEOpenApplication, + NewAEEventHandlerProc (HandleOpenApplication), + 0, false); + if (err != noErr) goto failed; + + err = AEInstallEventHandler (kCoreEventClass, kAEQuitApplication, + NewAEEventHandlerProc (HandleQuitApplication), + 0, false); + if (err != noErr) goto failed; + + err = AEInstallEventHandler (kCoreEventClass, kAEOpenDocuments, + NewAEEventHandlerProc (HandleOpenDocuments), + 0, false); + if (err != noErr) goto failed; + + err = AEInstallEventHandler (kCoreEventClass, kAEPrintDocuments, + NewAEEventHandlerProc (HandlePrintDocuments), + 0, false); + if (err != noErr) goto failed; + + return noErr; + + failed: + return err; +} diff --git a/maccaml/clipboard.c b/maccaml/clipboard.c new file mode 100644 index 000000000..33fade12f --- /dev/null +++ b/maccaml/clipboard.c @@ -0,0 +1,38 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +WindowPtr clip_window = NULL; + +/* Open clipboard window or bring it to the front. */ +void ClipShow (void) +{ + if (clip_window != NULL){ + SelectWindow (clip_window); + }else{ + XXX (); + } +} + +void ClipClose (void) +{ + XXX (); +} + +void ClipChanged (void) +{ + if (clip_window != NULL){ + XXX (); + } +} diff --git a/maccaml/constants.h b/maccaml/constants.h new file mode 100644 index 000000000..f476c1dbb --- /dev/null +++ b/maccaml/constants.h @@ -0,0 +1,177 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#define kMinSystemVersion 0x700 + +#define kExtraStackSpace (128 * 1024) +#define kMoreMasters 6 +#define kScrapThreshold (4 * 1024) +#define kMinimumMemory (32 * 1024) + +#define kTitleBarSpace 20 +#define kWinBorderSpace 5 +#define kPowerStripSpace 20 +#define kVisualDelay 8UL /* XXX use double-click time ?? */ + +#define ktextwidth 32000 +#define kHorizScrollDelta 32 +#define kGraphScrollDelta 8 +#define kScrollBarWidth 15 /* not counting one of the borders. */ +#define kTextMarginV 3 +#define kTextMarginH 6 +#define kMinWindowWidth 64 +#define kMinWindowHeight 64 + +#define keyPgUp 0x74 +#define keyPgDn 0x79 +#define keyHome 0x73 +#define keyEnd 0x77 +#define keyF1 0x7A +#define keyF2 0x78 +#define keyF3 0x63 +#define keyF4 0x76 + +#define charEnter 0x03 +#define charBackspace 0x08 +#define charReturn 0x0D +#define charEscape 0x1B + +#define kWinUnknown 0 +#define kWinUninitialised 1 +#define kWinAbout 2 +#define kWinToplevel 3 +#define kWinGraphics 4 +#define kWinDocument 5 +#define kWinPrefs 6 +#define kWinClipboard 7 + +#define kCreatorCaml 'Caml' +#define kTypeText 'TEXT' + +/* Resource IDs */ + +#define kToplevelWinTemplate 1000 +#define kGraphicsWinTemplate 1001 +#define kDocumentWinTemplate 1002 + +#define kScrollBarTemplate 1000 + +#define kJoeCamlIcon 1000 /* see ocaml.r(ICON/cicn) before changing */ + +#define kDialogAbout 1000 +#define kAlertNeedSys7 1001 +#define kAlertBug 1002 +#define kAlertGeneric 1003 +#define kAlertNonzeroExit 1004 +#define kDialogPrefs 1005 +#define kAlertNotYet 1006 +#define kAlertSaveAsk 1007 +#define kAlertErrorMsg 1008 +#define kAlertErrorNum 1009 +#define kAlertNeed32BitQD 1010 + +#define kKeysOK 1000 +#define kKeysSaveDontCancel 1001 + +#define kPrefsDescriptionStr 1000 +#define kApplicationMissing -16397 + +#define kUndoStrings 1000 + +#define kMiscStrings 1001 +#define kPrefsFileNameIdx 1 +#define kUntitledIdx 2 +#define kClosingIdx 3 +#define kQuittingIdx (kClosingIdx + 1) +#define kCannotOpenIdx 5 +#define kCloseQuoteIdx 6 +#define kSaveAsPromptIdx 7 +#define kEmptyIdx 8 +#define kCannotWriteIdx 9 + +#define kErrorStrings 1002 +#define kMemFull 1 +#define kDiskFull 2 +#define kDirFull 3 +#define kTooManyFiles 4 +#define kFileNotFound 5 +#define kWriteProtect 6 +#define kFileLocked 7 +#define kVolLocked 8 +#define kFileBusy 9 +#define kFileOpen 10 +#define kVolOffLine 11 +#define kPermDenied 12 +#define kWritePermDenied 13 +#define kDirNotFound 14 +#define kDisconnected 15 +#define kIOError 16 + +#define kAboutText 1000 + +#define kMenuBar 1000 + +#define kCommandLineTemplate 1000 +#define kEnvironmentTemplate 1001 + + +/* Sound stuff */ + +#define kDurationOffset 0x1E +#define kSampleRateOffset 0x34 + + +/* Menus */ + +#define kMenuApple 1000 +#define kMenuFile 1001 +#define kMenuEdit 1002 +#define kMenuWindows 1003 + +/***** Apple menu */ +#define kItemAbout 1 + +/***** File menu */ +#define kItemNew 1 +#define kItemOpen 2 +/* - */ +#define kItemClose 4 +#define kItemSave 5 +#define kItemSaveAs 6 +#define kItemRevert 7 +/* - */ +#define kItemPageSetup 9 +#define kItemPrint 10 +/* - */ +#define kItemQuit 12 + +/***** Edit menu */ +#define kItemUndo 1 +/* - */ +#define kItemCut 3 +#define kItemCopy 4 +#define kItemPaste 5 +#define kItemClear 6 +#define kItemSelectAll 7 +#define kItemShowClipboard 8 +/* - */ +#define kItemFind 10 +#define kItemReplace 11 +/* - */ +#define kItemPreferences 13 + +/***** Windows menu */ +#define kItemToplevel 1 +#define kItemGraphics 2 +/* - */ +#define kItemDocuments 4 diff --git a/maccaml/drag.c b/maccaml/drag.c new file mode 100644 index 000000000..7d7b4630c --- /dev/null +++ b/maccaml/drag.c @@ -0,0 +1,239 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +static DragTrackingHandlerUPP MyTrackingHandlerUPP = NULL; +static DragReceiveHandlerUPP MyReceiveHandlerUPP = NULL; + +static OSErr ToplevelTrackDrag (DragTrackingMessage message, DragReference drag) +{ + static int canacceptdrag = 0; + static int hilited = 0; + WEReference we = WinGetWE (winToplevel); + short readonly; + Point mouse; + RgnHandle rgn = NewRgn (); + Rect viewrect; + LongRect lviewrect; + OSErr err; + DragAttributes attributes; + + Assert (we != NULL); + switch (message){ + + case kDragTrackingEnterWindow: + readonly = WEFeatureFlag (weFReadOnly, weBitTest, we); + WEFeatureFlag (weFReadOnly, weBitClear, we); + canacceptdrag = WECanAcceptDrag (drag, we); + if (readonly) WEFeatureFlag (weFReadOnly, weBitSet, we); + break; + + case kDragTrackingInWindow: + if (canacceptdrag){ + err = GetDragAttributes (drag, &attributes); + if (err != noErr) goto failed; + err = GetDragMouse (drag, &mouse, nil); + if (err != noErr) goto failed; + GlobalToLocal (&mouse); + WEGetViewRect (&lviewrect, we); + WELongRectToRect (&lviewrect, &viewrect); + InsetRect (&viewrect, -kTextMarginH, 0); + if (PtInRect (mouse, &viewrect)){ + if (!hilited && (attributes & kDragHasLeftSenderWindow)){ + RectRgn (rgn, &viewrect); + InsetRgn (rgn, 0, -kTextMarginV); + ShowDragHilite (drag, rgn, true); + DisposeRgn (rgn); + hilited = 1; + } + }else{ + if (hilited){ + HideDragHilite (drag); + hilited = 0; + } + } + } + break; + + case kDragTrackingLeaveWindow: + if (hilited){ + HideDragHilite (drag); + hilited = 0; + } + break; + + default: break; + } + return noErr; + + failed: return err; +} + +static pascal OSErr MyTrackingHandler (DragTrackingMessage message, WindowPtr w, + void *refCon, DragReference drag) +{ + #pragma unused (refCon) + WEReference we; + + switch (WinGetKind (w)){ + case kWinUnknown: + case kWinUninitialised: + case kWinAbout: + case kWinGraphics: + case kWinPrefs: + case kWinClipboard: + return noErr; + + case kWinToplevel: + return ToplevelTrackDrag (message, drag); + + case kWinDocument: + we = WinGetWE (w); Assert (we != NULL); + return WETrackDrag (message, drag, we); + + default: + Assert (0); + return noErr; + } +} + +static OSErr ToplevelReceiveDrag (DragReference drag, WEReference we) +{ + GrafPtr (saveport); + short readonly = 0; + Boolean canaccept; + OSErr err; + Point mouse; + LongRect lviewrect; + Rect viewrect; + UInt16 nitems; + UInt16 i; + ItemReference itemref; + Handle h = NULL; + Size sz, curlen; + long dest, selstart, selend = -1; + + GetPort (&saveport); + SetPortWindowPort (winToplevel); + + readonly = WEFeatureFlag (weFReadOnly, weBitTest, we); + if (readonly) WEFeatureFlag (weFReadOnly, weBitClear, we); + canaccept = WECanAcceptDrag (drag, we); + if (!canaccept){ err = badDragFlavorErr; goto failed; } + + err = GetDragMouse (drag, &mouse, nil); + if (err != noErr) goto failed; + GlobalToLocal (&mouse); + WEGetViewRect (&lviewrect, we); + WELongRectToRect (&lviewrect, &viewrect); + if (!PtInRect (mouse, &viewrect)){ err = dragNotAcceptedErr; goto failed; } + + /* XXX Ne pas coller si le drag vient de la mme fentre et la souris + est revenue dans la sŽlection. */ + + h = NewHandle (0); + err = MemError (); if (err != noErr) goto failed; + curlen = 0; + + err = CountDragItems (drag, &nitems); + if (err != noErr) goto failed; + + for (i = 1; i <= nitems; i++){ + err = GetDragItemReferenceNumber (drag, i, &itemref); + if (err != noErr) goto failed; + err = GetFlavorDataSize (drag, itemref, kTypeText, &sz); + if (err != noErr) goto failed; + SetHandleSize (h, curlen + sz); + err = MemError (); if (err != noErr) goto failed; + HLock (h); + err = GetFlavorData (drag, itemref, kTypeText, (*h)+curlen, &sz, 0); + HUnlock (h); + if (err != noErr) goto failed; + curlen += sz; + } + dest = WEGetTextLength (we); + WEGetSelection (&selstart, &selend, we); + WESetSelection (dest, dest, we); + WESetStyle (weDoFont + weDoFace + weDoSize + weDoColor + weDoReplaceFace, + &prefs.unread, we); + HLock (h); + err = WEInsert (*h, curlen, NULL, NULL, we); + HUnlock (h); + if (err != noErr) goto failed; + WESetSelection (dest + curlen, dest + curlen, we); + + DisposeHandle (h); + SetPort (saveport); + return noErr; + + failed: + if (h != NULL) DisposeHandle (h); + if (selend != -1) WESetSelection (selstart, selend, we); + if (readonly) WEFeatureFlag (weFReadOnly, weBitSet, we); + SetPort (saveport); + return err; +} + +static pascal OSErr MyReceiveHandler (WindowPtr w, void *refCon, + DragReference drag) +{ + #pragma unused (refCon) + WEReference we; + + switch (WinGetKind (w)){ + case kWinUnknown: + case kWinUninitialised: + case kWinAbout: + case kWinGraphics: + case kWinPrefs: + case kWinClipboard: + return noErr; + case kWinToplevel: + we = WinGetWE (w); Assert (we != NULL); + return ToplevelReceiveDrag (drag, we); + case kWinDocument: + we = WinGetWE (w); Assert (we != NULL); + return WEReceiveDrag (drag, we); + default: + Assert (0); + return noErr; + } +} + +OSErr InstallDragHandlers (void) +{ + OSErr err; + + MyTrackingHandlerUPP = NewDragTrackingHandlerProc (MyTrackingHandler); + MyReceiveHandlerUPP = NewDragReceiveHandlerProc (MyReceiveHandler); + + err = InstallTrackingHandler (MyTrackingHandlerUPP, NULL, NULL); + if (err != noErr) return err; + err = InstallReceiveHandler (MyReceiveHandlerUPP, NULL, NULL); + if (err != noErr){ + RemoveTrackingHandler (MyTrackingHandlerUPP, NULL); + return err; + } + return noErr; +} + +OSErr RemoveDragHandlers (void) +{ + OSErr err1, err2; + + err1 = RemoveTrackingHandler (MyTrackingHandlerUPP, NULL); + err2 = RemoveReceiveHandler (MyReceiveHandlerUPP, NULL); + if (err2 != noErr && err1 == noErr) return err2; + return err1; +} diff --git a/maccaml/errors.c b/maccaml/errors.c new file mode 100644 index 000000000..eb4f7b78d --- /dev/null +++ b/maccaml/errors.c @@ -0,0 +1,112 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +static int exiting = 0; + +void assert_failure (char *condition, char *file, int line) +{ + Str255 buf; + + if (exiting) ExitToShell (); + exiting = 1; + NumToString ((long) line, buf); + ParamText (c2pstr (condition), c2pstr (file), buf, NULL); + InitCursor (); + modalkeys = kKeysOK; + StopAlert (kAlertBug, myModalFilterUPP); + ExitApplication (); +} + +void XXX (void) +{ + InitCursor (); + modalkeys = kKeysOK; + StopAlert (kAlertNotYet, myModalFilterUPP); +} + +void ErrorAlert (short msg1, Str255 bufmsg2, short msg3, OSErr err) +{ + Str255 bufmsg1, bufmsg3, bufmsg4; + short msg; + + switch (err){ + case noErr: + case userCanceledErr: return; + + case mFulErr: + case memFullErr: + case cTempMemErr: + case cNoMemErr: + case updPixMemErr: msg = kMemFull; break; + case dskFulErr: + case afpDiskFull: msg = kDiskFull; break; + case dirFulErr: msg = kDirFull; break; + case tmfoErr: + case afpTooManyFilesOpen: msg = kTooManyFiles; break; + case fnfErr: msg = kFileNotFound; break; + case wPrErr: msg = kWriteProtect; break; + case fLckdErr: + case afpObjectLocked: msg = kFileLocked; break; + case vLckdErr: + case afpVolLocked: msg = kVolLocked; break; + case fBsyErr: + case afpFileBusy: msg = kFileBusy; break; + case opWrErr: msg = kFileOpen; break; + case volOffLinErr: msg = kVolOffLine; break; + case permErr: + case afpAccessDenied: msg = kPermDenied; break; + case wrPermErr: msg = kWritePermDenied; break; + case dirNFErr: msg = kDirNotFound; break; + case volGoneErr: + case afpSessClosed: msg = kDisconnected; break; + case ioErr: msg = kIOError; break; + + default: msg = 0; break; + } + + GetIndString (bufmsg1, kMiscStrings, msg1); + GetIndString (bufmsg3, kMiscStrings, msg3); + + if (msg != 0){ + GetIndString (bufmsg4, kErrorStrings, msg); + ParamText (bufmsg1, bufmsg2, bufmsg3, bufmsg4); + }else{ + NumToString (err, bufmsg4); + ParamText (bufmsg1, bufmsg2, bufmsg3, bufmsg4); + } + InitCursor (); + modalkeys = kKeysOK; + StopAlert (msg ? kAlertErrorMsg : kAlertErrorNum, myModalFilterUPP); +} + +void ErrorAlertCantOpen (Str255 filename, OSErr err) +{ + ErrorAlert (kCannotOpenIdx, filename, kCloseQuoteIdx, err); +} + +void ErrorAlertGeneric (OSErr err) +{ + ErrorAlert (kEmptyIdx, "\p", kEmptyIdx, err); +} + +OSErr InitialiseErrors (void) +{ +/* XXX CouldAlert n'existe plus ?? + CouldAlert (kAlertErrorMsg); + CouldAlert (kAlertErrorNum); + CouldAlert (kAlertBug); +*/ + return noErr; +} diff --git a/maccaml/events.c b/maccaml/events.c new file mode 100644 index 000000000..578f3e0f5 --- /dev/null +++ b/maccaml/events.c @@ -0,0 +1,310 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +UInt32 evtSleep = 0; +static RgnHandle mouseRegion = NULL; +static RgnHandle pointRegion = NULL; + +static void AdjustCursor (Point mouse, RgnHandle mouseRegion) +{ + WindowPtr w = FrontWindow (); + WEHandle we = WinGetWE (w); + int k = WinGetKind (w); + + if (caml_at_work && w == winToplevel) return; + SetRectRgn (mouseRegion, -SHRT_MAX, -SHRT_MAX, SHRT_MAX, SHRT_MAX); + if (we != NULL && k != kWinAbout){ + if (WEAdjustCursor (mouse, mouseRegion, we)) return; + } + SetCursor (&qd.arrow); +} + +static void DoActivate (EventRecord *evt) +{ + WindowPtr w = (WindowPtr) evt->message; + + if (GetWindowKind (w) != userKind) return; /*XXX*/ + WinActivateDeactivate (evt->modifiers & activeFlag, w); +} + +static void DoDiskEvent (EventRecord *evt) +{ + OSErr err; + Point pt; + + if (evt->message >> 16 != noErr){ + DILoad (); + err = DIBadMount (pt, evt->message); /* [pt] is ignored */ + if (err != noErr) ErrorAlertGeneric (err); /* XXX or nothing ? */ + DIUnload (); + } +} + +static void DoKeyDown (EventRecord *evt) +{ + short chr = evt->message & charCodeMask; + Boolean isCmdKey = (evt->modifiers & cmdKey) != 0; + + if (chr == 0x10){ + switch ((evt->message & keyCodeMask) >> 8){ + case keyF1: + isCmdKey = 1; + chr = 'z'; + break; + case keyF2: + isCmdKey = 1; + chr = 'x'; + break; + case keyF3: + isCmdKey = 1; + chr = 'c'; + break; + case keyF4: + isCmdKey = 1; + chr = 'v'; + break; + default: + chr = -1; + } + } + if (isCmdKey && chr == '.' && FrontWindow () == winToplevel){ + if (evt->what != autoKey){ + /* If the signal handler calls longjmp, then it will jump into the + bytecode interpreter and Caml will be working. If it does not, + then Caml must have been working already because we are not in + a blocking section. In all cases, raising a signal puts Caml + to work. + */ + Caml_working (1); + raise (SIGINT); + } + }else if (isCmdKey && chr >= 0x20){ + UpdateMenus (); + DoMenuChoice (MenuKey (chr), evt->modifiers); + }else{ + WindowPtr w = FrontWindow (); + if (chr != -1 && w != NULL){ + WinDoKey (w, chr, evt); + } + } +} + +static void DoMouseDown (EventRecord *event) +{ + WindowPtr w; + short partCode; + + partCode = FindWindow (event->where, &w); + switch (partCode){ + case inMenuBar: + UpdateMenus (); + DoMenuChoice (MenuSelect (event->where), event->modifiers); + break; + case inSysWindow: + SystemClick (event, w); + break; + case inContent: + WinDoContentClick (event, w); + break; + case inDrag: + WinDoDrag (event->where, w); + break; + case inGrow: + WinDoGrow (event->where, w); + break; + case inGoAway: + if (TrackGoAway (w, event->where)) WinDoClose (closingWindow, w); + break; + case inZoomIn: + case inZoomOut: + if (TrackBox (w, event->where, partCode)) WinDoZoom (w, partCode); + break; + } +} + +/* XXX recuperer les mouse-up pour matcher les mouse-down ? */ +static void DoMouseUp (EventRecord *e) +{ + short partCode; + WindowPtr w; + Point hitpt; + GrafPtr saveport; + Rect r; + + if (FrontWindow () != winGraphics) return; + partCode = FindWindow (e->where, &w); + if (partCode != inContent) return; + GetPort (&saveport); + SetPort (winGraphics); + hitpt = e->where; + GlobalToLocal (&hitpt); + ScrollCalcGraph (winGraphics, &r); + if (PtInRect (hitpt, &r)) GraphGotEvent (e); + SetPort (saveport); + return; +} + +static void DoNullEvent (EventRecord *event) +{ + WindowPtr w = FrontWindow (); + + if (w != NULL) WinDoIdle (w); +} + +static void DoOSEvent (EventRecord *event) +{ + int msg = (event->message & osEvtMessageMask) >> 24; + WindowPtr w; + + switch (msg){ + case suspendResumeMessage: + w = FrontWindow (); + if (w != NULL){ + Boolean state = !! (event->message & resumeFlag); + WinActivateDeactivate (state, w); + } + if (event->message & convertClipboardFlag) ClipChanged (); + case mouseMovedMessage: ; + } +} + +static void DoUpdate (EventRecord *evt) +{ + WindowPtr w = (WindowPtr) evt->message; + + if (GetWindowKind (w) != userKind) return; /*XXX*/ + WinUpdate (w); +} + +static void DoDialogEvent (EventRecord *evt) +{ + DialogPtr dlg; + short itm; + + if (evt->what == diskEvt){ + DoDiskEvent (evt); + return; + }else if (evt->what == keyDown || evt->what == autoKey){ + if (evt->modifiers & cmdKey){ + DoKeyDown (evt); + return; + }else{ + switch ((evt->message & charCodeMask) >> 8){ + case '\n': + XXX (); /*XXX return key*/ + return; + case '\033': + XXX (); /*XXX escape key */ + return; + default: break; + } + } + } + if (DialogSelect (evt, &dlg, &itm)){ + switch (WinGetKind (dlg)){ + case kWinAbout: + Assert (0); /* No item is enabled. */ + break; + case kWinPrefs: + XXX (); + break; + default: + Assert (0); /* Other windows are not dialogs. */ + break; + } + } +} + +static pascal Boolean ProcessEvent (EventRecord *evt, long *sleep, + RgnHandle *rgn) +{ + if (evt->what <= osEvt) AdjustCursor (evt->where, mouseRegion); + if (IsDialogEvent (evt)){ + DoDialogEvent (evt); + }else{ + switch (evt->what){ + case nullEvent: + DoNullEvent (evt); + break; + case mouseDown: + DoMouseDown (evt); + break; + case mouseUp: /* Needed for the graphics window. */ + DoMouseUp (evt); + break; + case keyDown: + case autoKey: + DoKeyDown (evt); + break; + case updateEvt: + DoUpdate (evt); + break; + case activateEvt: + DoActivate (evt); + break; + case diskEvt: + DoDiskEvent (evt); + break; + case osEvt: + DoOSEvent (evt); + break; + case kHighLevelEvent: + AEProcessAppleEvent (evt); + break; + } + } + *sleep = evt->what == nullEvent ? evtSleep : 0; + *rgn = mouseRegion; + return false; +} + +void GetAndProcessEvents (WaitEventOption wait, short oldx, short oldy) +{ + EventRecord evt; + long dummysleep; + RgnHandle dummyregion; + UInt32 cursleep = wait != noWait ? evtSleep : 0; + RgnHandle currgn; + + if (wait == waitMove){ + currgn = pointRegion; + SetRectRgn (pointRegion, oldx, oldy, oldx+1, oldy+1); + }else{ + currgn = mouseRegion; + } + + WaitNextEvent (everyEvent, &evt, cursleep, currgn); + ProcessEvent (&evt, &dummysleep, &dummyregion); + if (quit_requested) ExitApplication (); + + while (evt.what != nullEvent){ + WaitNextEvent (everyEvent, &evt, 0, NULL); + ProcessEvent (&evt, &dummysleep, &dummyregion); + if (quit_requested) ExitApplication (); + } +} + +AEIdleUPP ProcessEventUPP; + +OSErr InitialiseEvents (void) +{ + OSErr err; + + mouseRegion = NewRgn (); /* XXX out of memory ? */ + pointRegion = NewRgn (); /* XXX out of memory ? */ + ProcessEventUPP = NewAEIdleProc (ProcessEvent); + err = InstallAEHandlers (); + return err; +} diff --git a/maccaml/files.c b/maccaml/files.c new file mode 100644 index 000000000..9ac7980b8 --- /dev/null +++ b/maccaml/files.c @@ -0,0 +1,426 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +static unsigned long nuntitled = 0; +static unsigned long count = 2; + +/* XXX prŽvoir le cas o on peut Žcrire le texte mais pas les ressources + -> resrefnum peut tre -1 quand datarefnum est valide +*/ + +static void MakeUntitledTitle (Str255 result) +{ + char buffer [15]; + + GetIndString (result, kMiscStrings, kUntitledIdx); + if (nuntitled != 0){ + if (result [0] > 240) result [0] = 240; + sprintf (buffer, " %lu", count); Assert (strlen (buffer) < 15); + strcpy ((char *) result + result [0] + 1, buffer); + result [0] += strlen (buffer); + ++ count; + }else{ + count = 2; + } + ++ nuntitled; +} + +static void FreeUntitledTitle () +{ + -- nuntitled; +} + +/* Close the file associated with the window, saving it if needed. */ +OSErr FileDoClose (WindowPtr w, ClosingOption close) +{ + WStatusH st; + WEHandle we; + Str255 savingprompt, filename; + short item; + OSErr err; + + Assert (WinGetKind (w) == kWinDocument); + WinUpdateStatus (w); + st = WinGetStatus (w); Assert (st != NULL); + we = WinGetWE (w); Assert (we != NULL); + GetWTitle (w, filename); + if ((*st)->dirty){ + GetIndString (savingprompt, kMiscStrings, kClosingIdx + close); + ParamText (filename, savingprompt, NULL, NULL); + InitCursor (); + modalkeys = kKeysSaveDontCancel; + item = Alert (kAlertSaveAsk, myModalFilterUPP); + switch (item){ + case 1: /* Yes */ + err = FileDoSave (w, 0); + if (err != noErr) return err; + break; + case 2: /* Cancel */ + return userCanceledErr; + case 3: /* No */ + break; + default: Assert (0); + } + }else{ + if ((*st)->resrefnum != -1){ + /* XXX sauver fenetre, selection, scrollbars */ + } + } + if ((*st)->datarefnum == -1){ + Assert ((*st)->resrefnum == -1); + FreeUntitledTitle (); + }else{ + FSClose ((*st)->datarefnum); + if ((*st)->resrefnum != -1) CloseResFile ((*st)->resrefnum); + } + return noErr; +} + +/* Open a new untitled window. */ +void FileNew (void) +{ + Str255 titlebuf; + WindowPtr w; + OSErr err; + WStatusH st; + + MakeUntitledTitle (titlebuf); + w = WinOpenDocument ((StringPtr) titlebuf); + if (w == NULL) {err = 0/*XXX*/; goto failed; } + st = WinGetStatus (w); Assert (st != NULL); + (*st)->datarefnum = (*st)->resrefnum = -1; + return; + + failed: + if (w != NULL) WinDoClose (closingWindow, w); + ErrorAlertGeneric (err); +} + +/* Open the specified file in a new window. */ +OSErr FileOpen (FSSpec *filespec) + { + WindowPtr w = NULL; + WStatusH st; + StringPtr title; + Str255 titlebuf; + short resrefnum = -1, datarefnum = -1; + Size textsize; + Handle texthandle = NULL; + OSErr err; + int template; + SignedByte perm; + FInfo fileinfo; + + err = FSpGetFInfo (filespec, &fileinfo); + if (err != noErr) goto failed; + if (fileinfo.fdFlags & kIsStationery){ + MakeUntitledTitle (titlebuf); + title = (StringPtr) titlebuf; + template = 1; + }else{ + title = (StringPtr) filespec->name; + template = 0; + } + perm = template ? fsRdPerm : fsRdWrPerm; + + err = FSpOpenDF (filespec, perm, &datarefnum); + if (err != noErr){ datarefnum = -1; goto failed; } + err = GetEOF (datarefnum, &textsize); + if (err != noErr) goto failed; + err = SetFPos (datarefnum, fsFromStart, 0L); + if (err != noErr) goto failed; + err = AllocHandle (textsize, &texthandle); + if (err != noErr) goto failed; + HLock (texthandle); + err = FSRead (datarefnum, &textsize, *texthandle); + HUnlock (texthandle); + if (err != noErr) goto failed; + + /*XXX FSpCreateResFile (filespec, creator, type, 0); */ + resrefnum = FSpOpenResFile (filespec, perm); + if (resrefnum != -1){ + /* XXX lire la position de la fentre, la sŽlection, les scrollbars */ + } + + w = WinOpenDocument (title); + if (w == NULL) { err = 0/*XXX*/; goto failed; } + st = WinGetStatus (w); Assert (st != NULL); + + WEUseText (texthandle, (*st)->we); + WECalText ((*st)->we); + WESetSelection (0, 0, (*st)->we); /* XXX */ + AdjustScrollBars (w); + WEResetModCount ((*st)->we); + (*st)->basemodcount = 0; + + if (template){ + FSClose (datarefnum); + if (resrefnum != -1) CloseResFile (resrefnum); + (*st)->datarefnum = (*st)->resrefnum = -1; + }else{ + (*st)->datarefnum = datarefnum; + (*st)->resrefnum = resrefnum; + } + return noErr; + + failed: + if (texthandle != NULL) DisposeHandle (texthandle); + if (datarefnum != -1) FSClose (datarefnum); + if (resrefnum != -1) CloseResFile (resrefnum); + if (w != NULL) WinDoClose (closingWindow, w); + return err; +} + +/* Get a file with the standard dialog and open it in a new window. */ +void FileDoGetOpen (void) +{ + OSErr err; + StandardFileReply sfreply; + SFTypeList types = { 'TEXT' }; + + StandardGetFile (NULL, 1, types, &sfreply); + if (sfreply.sfGood){ + err = FileOpen (&sfreply.sfFile); + if (err != noErr) ErrorAlertCantOpen (sfreply.sfFile.name, err); + } +} + +/* Revert w to the contents of its associated file. */ +void FileRevert (WindowPtr w) +{ + WStatusH st; + short err; + Size textsize; + Handle texthandle; + + /*XXX demander confirmation */ + + st = WinGetStatus (w); + Assert (st != NULL); + Assert ((*st)->datarefnum != -1); + Assert ((*st)->we != NULL); + + err = GetEOF ((*st)->datarefnum, &textsize); + if (err != noErr) goto failed; + err = SetFPos ((*st)->datarefnum, fsFromStart, 0L); + if (err != noErr) goto failed; + err = AllocHandle (textsize, &texthandle); + if (err != noErr) goto failed; + HLock (texthandle); + err = FSRead ((*st)->datarefnum, &textsize, *texthandle); + HUnlock (texthandle); + if (err != noErr) goto failed; + + /* XXX lire la sŽlection (pas la scrollbar ?) */ + + SetPortWindowPort (w); + WEUseText (texthandle, (*st)->we); + WECalText ((*st)->we); + WEUpdate (NULL, (*st)->we); + WESetSelection (0, 0, (*st)->we); /* XXX */ + AdjustScrollBars (w); + WEResetModCount ((*st)->we); + (*st)->basemodcount = 0; + return; + + failed: + if (texthandle != NULL) DisposeHandle (texthandle); + ErrorAlertGeneric (err); +} + +/* Save the text to datarefnum. + If resrefnum != -1, save the window position and the current selection. +*/ +static OSErr SaveText (WindowPtr w, short datarefnum, short resrefnum) +{ + WStatusH st = WinGetStatus (w); + Handle text; + Size textsize; + OSErr err; + + Assert (st != NULL); + Assert ((*st)->we != NULL); + err = SetEOF (datarefnum, 0L); + if (err != noErr) goto failed; + text = WEGetText ((*st)->we); + textsize = GetHandleSize (text); + HLock (text); + err = FSWrite (datarefnum, &textsize, *text); + HUnlock (text); + if (err != noErr) goto failed; + (*st)->basemodcount = WEGetModCount ((*st)->we); + + if (resrefnum != -1){ + /* XXX Žcrire la sŽlection et la position des scrollbars + attention: pas de fail. */ + } + return noErr; + + failed: + return err; +} + +/* Ask the user for a new file name, open both forks, and return + the refnums. +*/ +static OSErr PrepSaveAs (WindowPtr w, short *datarefnum, short *resrefnum, + StandardFileReply *reply) +{ + Str255 prompt, title; + OSErr err; + short auxrefnum = -1; + + *datarefnum = *resrefnum = -1; + + GetIndString (prompt, kMiscStrings, kSaveAsPromptIdx); + GetWTitle (w, title); + StandardPutFile (prompt, title, reply); + + if (reply->sfGood){ + if (reply->sfReplacing){ + err = FSpOpenDF (&reply->sfFile, fsRdWrPerm, datarefnum); + if (err != noErr) *datarefnum = -1; + if (err == opWrErr || err == fLckdErr || err == afpObjectLocked + || err == permErr || err == afpAccessDenied || err == wrPermErr){ + ErrorAlert (kCannotWriteIdx, reply->sfFile.name, kCloseQuoteIdx, err); + } + if (err != noErr) goto failed; + + err = FSpOpenRF (&reply->sfFile, fsRdWrPerm, &auxrefnum); + if (err != noErr) auxrefnum = -1; + if (err == opWrErr || err == fLckdErr || err == afpObjectLocked + || err == permErr || err == afpAccessDenied){ + ErrorAlert (kCannotWriteIdx, reply->sfFile.name, kCloseQuoteIdx, err); + } + if (err != noErr) goto failed; + + err = SetEOF (auxrefnum, 0L); + if (err != noErr) goto failed; + FSClose (auxrefnum); auxrefnum = -1; + FSpCreateResFile (&reply->sfFile, kCreatorCaml,kTypeText,reply->sfScript); + err = ResError (); if (err != noErr) goto failed; + *resrefnum = FSpOpenResFile (&reply->sfFile, fsRdWrPerm); + if (*resrefnum == -1){ err = ResError (); goto failed; } /*XXX ?? */ + + err = SetEOF (*datarefnum, 0L); + if (err != noErr) goto failed; + + }else{ + err = FSpCreate (&reply->sfFile, kCreatorCaml, kTypeText,reply->sfScript); + if (err != noErr) goto failed; + FSpCreateResFile (&reply->sfFile, kCreatorCaml,kTypeText,reply->sfScript); + err = ResError (); if (err != noErr) goto failed; + err = FSpOpenDF (&reply->sfFile, fsRdWrPerm, datarefnum); + if (err != noErr){ *datarefnum = -1; goto failed; } + *resrefnum = FSpOpenResFile (&reply->sfFile, fsRdWrPerm); + if (*resrefnum == -1){ err = ResError (); goto failed; } /*XXX ?? */ + } + }else{ + err = userCanceledErr; + goto failed; + } + return noErr; + + failed: + if (*datarefnum != -1) FSClose (*datarefnum); + if (*resrefnum != -1) CloseResFile (*resrefnum); + if (auxrefnum != -1) FSClose (auxrefnum); + return err; +} + +/* If saveasflag is true or there is no associated file, + then ask for a new file name with the standard dialog + and associate it with w. + + Save the contents of w to its associated file. +*/ +static OSErr SaveDocument (WindowPtr w, int saveasflag) +{ + WStatusH st = WinGetStatus (w); + OSErr err; + int changetitle = 0; + short datarefnum = -1, resrefnum = -1; + + Assert (st != NULL); + if (saveasflag || (*st)->datarefnum == -1){ + StandardFileReply reply; + + err = PrepSaveAs (w, &datarefnum, &resrefnum, &reply); + if (err != noErr) goto failed; + + if ((*st)->datarefnum == -1){ + Assert ((*st)->resrefnum == -1); + FreeUntitledTitle (); + }else{ + Assert ((*st)->resrefnum != -1); + FSClose ((*st)->datarefnum); + if ((*st)->resrefnum != -1) CloseResFile ((*st)->resrefnum); + (*st)->datarefnum = (*st)->resrefnum = -1; + } + (*st)->datarefnum = datarefnum; + (*st)->resrefnum = resrefnum; + SetWTitle (w, reply.sfFile.name); + datarefnum = resrefnum = -1; + } + err = SaveText (w, (*st)->datarefnum, (*st)->resrefnum); + if (err != noErr) goto failed; + return noErr; + + failed: + if (datarefnum != -1) FSClose (datarefnum); + if (resrefnum != -1) CloseResFile (resrefnum); + return err; +} + +/* Save the toplevel window to a new file. Do not save the window + position or the current selection. +*/ +static OSErr SaveToplevel (void) +{ + WStatusH st; + StandardFileReply reply; + short datarefnum = -1, resrefnum = -1; + OSErr err; + + Assert (winToplevel != NULL); + st = WinGetStatus (winToplevel); + Assert (st != NULL); + + err = PrepSaveAs (winToplevel, &datarefnum, &resrefnum, &reply); + if (err != noErr) goto failed; + err = SaveText (winToplevel, datarefnum, -1); + if (err != noErr) goto failed; + FSClose (datarefnum); + if (resrefnum != -1) CloseResFile (resrefnum); + return noErr; + + failed: + if (datarefnum != -1) FSClose (datarefnum); + if (resrefnum != -1) CloseResFile (resrefnum); + return err; +} + +static OSErr SaveGraphics (void) +{ + XXX (); + return noErr; +} + +OSErr FileDoSave (WindowPtr w, int saveasflag) +{ + if (w == winToplevel) return SaveToplevel (); + else if (w == winGraphics) return SaveGraphics (); + else return SaveDocument (w, saveasflag); +} diff --git a/maccaml/glue.c b/maccaml/glue.c new file mode 100644 index 000000000..4068afbde --- /dev/null +++ b/maccaml/glue.c @@ -0,0 +1,507 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <CursorCtl.h> +#include <fcntl.h> +#include <signal.h> +#include <stdlib.h> + +#include "alloc.h" +#include "mlvalues.h" +#include "rotatecursor.h" +#include "signals.h" +#include "ui.h" + +#include "main.h" + +/* These are defined by the ocamlrun library. */ +void caml_main(char **argv); +char *getcwd (char *buf, long size); +Handle macos_getfullpathname (short vrefnum, long dirid); + +static int erroring = 0; +static long error_curpos; +static long error_anchor = -1; + +/* This handle contains the environment variables. */ +char *envPtr = NULL; + + +/* caml_at_work and Caml_working are used to manage the processor idle + state on PowerBooks (and also the beachball cursor: see AdjustCursor) +*/ +int caml_at_work = 0; + +/* Set caml_at_work to true or false. caml_at_work must always be + changed through this function, never directly. */ +void Caml_working (int newstate) +{ + if (gHasPowerManager){ + if (caml_at_work && !newstate) EnableIdle (); + if (!caml_at_work && newstate) DisableIdle (); + } + caml_at_work = newstate; +} + +/* Expand the percent escapes in the string specified by s. + The escapes are: + %a application file name + %d full pathname of the current working directory (ends in ':') + %t full pathname of the temporary directory (ends in ':') + %% % +*/ +static OSErr expand_escapes (Handle s) +{ + Size i, j, l; + OSErr err; + Handle curdir = NULL, tmpdir = NULL; + char *ptr2; + long len2; + + l = GetHandleSize (s) - 1; + i = j = 0; + while (i < l){ + if ((*s)[j] == '%'){ + switch ((*s)[j+1]){ + case 'a': + ptr2 = (char *) LMGetCurApName () + 1; + len2 = * (LMGetCurApName ()); + break; + case 'd': + if (curdir == NULL) curdir = macos_getfullpathname (0, 0); + if (curdir == NULL){ err = fnfErr; goto failed; } + HLock (curdir); + ptr2 = *curdir; + len2 = GetHandleSize (curdir); + break; + case 't': + if (tmpdir == NULL){ + short vrefnum; + long dirid; + err = FindFolder (kOnSystemDisk, kTemporaryFolderType, true, + &vrefnum, &dirid); + tmpdir = macos_getfullpathname (vrefnum, dirid); + if (tmpdir == NULL){ err = fnfErr; goto failed; } + } + HLock (tmpdir); + ptr2 = *tmpdir; + len2 = GetHandleSize (tmpdir); + break; + case '%': + ptr2 = "%"; + len2 = 1; + break; + default: + ptr2 = ""; + len2 = 0; + break; + } + Munger (s, j, NULL, 2, ptr2, len2); + j += len2 - 2; + i += 1; + } + ++ i; + ++ j; + } + if (curdir != NULL) DisposeHandle (curdir); + if (tmpdir != NULL) DisposeHandle (tmpdir); + return noErr; + + failed: + if (curdir != NULL) DisposeHandle (curdir); + if (tmpdir != NULL) DisposeHandle (tmpdir); + return err; +} + +/* [launch_caml_main] is called by [main]. + It builds the command line according to the template found in + the 'Line'(kCommandLineTemplate) resource and the environment + variables according to the 'Line'(kEnvironmentTemplate). + + Each of these resources is a sequence of strings separated by null + bytes. In each string, percent escapes are expanded (see above for + a description of percent escapes). + + Each resource must end with a null byte. +*/ + +OSErr launch_caml_main (void) +{ + Handle template = NULL; + Size len, i, j; + char *args = NULL; + int argc; + char **argv = NULL; + OSErr err; + + template = GetResource ('Line', kCommandLineTemplate); + if (template == NULL){ err = ResError (); goto failed; } + err = expand_escapes (template); if (err != noErr) goto failed; + len = GetHandleSize (template); + + args = malloc (len); + if (args == NULL){ err = memFullErr; goto failed; } + memcpy (args, *template, len); + + argc = 0; + for (i = 0; i < len; i++){ + if (args[i] == '\000') ++ argc; + } + argv = malloc ((argc+1) * sizeof (char *)); + if (argv == NULL){ err = memFullErr; goto failed; } + + i = j = 0; + do{ + argv[j++] = args + i; + while (args [i] != '\000') ++ i; + ++ i; + }while (i < len); + argv [argc] = NULL; + + ReleaseResource (template); + + template = GetResource ('Line', kEnvironmentTemplate); + if (template == NULL){ err = ResError (); goto failed; } + err = expand_escapes (template); if (err != noErr) goto failed; + len = GetHandleSize (template); + envPtr = NewPtr (len); + if (envPtr == NULL){ err = MemError (); goto failed; } + memcpy (envPtr, *template, len); + + rotatecursor_init (&something_to_do); + err = WinOpenToplevel (); + if (err != noErr) ExitApplication (); + + Assert (!caml_at_work); + Caml_working (1); + + caml_main (argv); + return noErr; /* Not reached */ + + failed: + if (template != NULL) ReleaseResource (template); + if (args != NULL) free (args); + if (argv != NULL) free (argv); + return err; +} + + +/*** + ui_* stubs for I/O +*/ + +static void (**atexit_list) (void) = NULL; +static long atexit_size = 0; +static long atexit_len = 0; + +void ui_exit (int return_code) +{ + int i; + + for (i = 0; i < atexit_len; i++) (*(atexit_list [i])) (); + + Assert (caml_at_work); + Caml_working (0); + + if (return_code != 0){ + Str255 errorstr; + + NumToString ((long) return_code, errorstr); + ParamText (errorstr, NULL, NULL, NULL); + modalkeys = kKeysOK; + InitCursor (); + NoteAlert (kAlertNonzeroExit, myModalFilterUPP); + } + while (1) GetAndProcessEvents (waitEvent, 0, 0); +} + +int atexit (void (*f) (void)) +{ + if (atexit_list == NULL){ + atexit_list = malloc (5 * sizeof (atexit_list [0])); + if (atexit_list == NULL) goto failed; + atexit_size = 5; + }else if (atexit_len >= atexit_size){ + void *p = realloc (atexit_list, (atexit_size+10) * sizeof (atexit_list[0])); + if (p == NULL) goto failed; + atexit_list = p; + atexit_size += 10; + } + Assert (atexit_size > atexit_len); + atexit_list [atexit_len++] = f; + return 0; + + failed: + /* errno = ENOMEM; est-ce que malloc positionne errno ? */ + return -1; +} + +int ui_read (int file_desc, char *buf, unsigned int length) +{ + if (file_desc == 0){ /* Read from the toplevel window. */ + long len, i; + char **htext; + WEReference we = WinGetWE (winToplevel); + long selstart, selend; + Boolean active; + short readonly, autoscroll; + int atend; + + Assert (we != NULL); + htext = (char **) WEGetText (we); + + Assert (caml_at_work); + Caml_working (0); + + while (1){ + char *p = *htext; /* The Handle is not locked. Be careful with p. */ + len = WEGetTextLength (we); + for (i = wintopfrontier; i < len; i++){ + if (p[i] == '\n') goto gotit; + } + GetAndProcessEvents (waitEvent, 0, 0); + } + + gotit: + + Assert (!caml_at_work); + Caml_working (1); + + len = i+1 - wintopfrontier; + if (len > length) len = length; + memcpy (buf, (*htext)+wintopfrontier, len); + + atend = ScrollAtEnd (winToplevel); + autoscroll = WEFeatureFlag (weFAutoScroll, weBitTest, we); + WEFeatureFlag (weFAutoScroll, weBitClear, we); + WEGetSelection (&selstart, &selend, we); + readonly = WEFeatureFlag (weFReadOnly, weBitTest, we); + WEFeatureFlag (weFReadOnly, weBitClear, we); + /* Always set an empty selection before changing OutlineHilite. */ + WESetSelection (wintopfrontier, wintopfrontier, we); + WEFeatureFlag (weFOutlineHilite, weBitClear, we); + active = WEIsActive (we); + if (active) WEDeactivate (we); + WESetSelection (wintopfrontier, wintopfrontier+len, we); + WESetStyle (weDoFont + weDoFace + weDoSize + weDoColor + weDoReplaceFace, + &prefs.input, we); + WESetSelection (wintopfrontier, wintopfrontier, we); + if (active) WEActivate (we); + WEFeatureFlag (weFOutlineHilite, weBitSet, we); + WESetSelection (selstart, selend, we); + if (readonly) WEFeatureFlag (weFReadOnly, weBitSet, we); + if (autoscroll) WEFeatureFlag (weFAutoScroll, weBitSet, we); + AdjustScrollBars (winToplevel); + if (atend) ScrollToEnd (winToplevel); + + WinAdvanceTopFrontier (len); + return len; + }else{ + return read (file_desc, buf, length); + } +} + +int ui_write (int file_desc, char *buf, unsigned int length) +{ + if (file_desc == 1 || file_desc == 2){ /* Send to the toplevel window. */ + long selstart, selend; + WEReference we = WinGetWE (winToplevel); + OSErr err; + short readonly, autoscroll; + int atend; + + if (erroring){ /* overwrite mode to display errors; see terminfo_* */ + error_curpos += length; Assert (error_curpos <= wintopfrontier); + return length; + } + + Assert (we != NULL); + + atend = ScrollAtEnd (winToplevel); + autoscroll = WEFeatureFlag (weFAutoScroll, weBitTest, we); + WEFeatureFlag (weFAutoScroll, weBitClear, we); + WEGetSelection (&selstart, &selend, we); + readonly = WEFeatureFlag (weFReadOnly, weBitTest, we); + WEFeatureFlag (weFReadOnly, weBitClear, we); + WESetSelection (wintopfrontier, wintopfrontier, we); + WESetStyle (weDoFont + weDoFace + weDoSize + weDoColor + weDoReplaceFace, + &prefs.output, we); + err = WEInsert (buf, (SInt32) length, NULL, NULL, we); + if (err != noErr){ + WESetSelection (selstart, selend, we); + /* XXX should set errno */ + return -1; + } + if (selstart >= wintopfrontier){ + selstart += length; + selend += length; + }else if (selend > wintopfrontier){ + selend += length; + } + WESetSelection (selstart, selend, we); + if (autoscroll) WEFeatureFlag (weFAutoScroll, weBitSet, we); + AdjustScrollBars (winToplevel); + if (atend) ScrollToEnd (winToplevel); + + WinAdvanceTopFrontier (length); + return length; + }else{ + return write (file_desc, buf, length); + } +} + +void ui_print_stderr (char *format, void *arg) +{ + char buf [1000]; /* XXX fixed size buffer :-( */ + + sprintf (buf, format, arg); Assert (strlen (buf) < 1000); + ui_write (2, buf, strlen (buf)); +} + + +/*** + animated cursor (only when toplevel window is frontmost) +*/ +typedef struct { + short nframes; + short current; + union { + CursHandle h; + struct { short id; short fill; } i; + } frames [1]; +} **AnimCursHandle; + +static AnimCursHandle acurh; + +pascal void InitCursorCtl (acurHandle newCursors) +{ +#pragma unused (newCursors) + long i; + + acurh = (AnimCursHandle) GetResource ('acur', 0); + for (i = 0; i < (*acurh)->nframes; i++){ + (*acurh)->frames[i].h = GetCursor ((*acurh)->frames[i].i.id); + if ((*acurh)->frames[i].h == NULL){ + (*acurh)->frames[i].h = GetCursor (watchCursor); + Assert ((*acurh)->frames[i].h != NULL); + } + } + (*acurh)->current = 0; +} + +/* In O'Caml, counter is always a multiple of 32. */ +pascal void RotateCursor (long counter) +{ + if (FrontWindow () == winToplevel){ + (*acurh)->current += (*acurh)->nframes + (counter >= 0 ? 1 : -1); + (*acurh)->current %= (*acurh)->nframes; + SetCursor (*((*acurh)->frames[(*acurh)->current].h)); + } + GetAndProcessEvents (noWait, 0, 0); +} + +/*** + "getenv" in the standalone application + envPtr is set up by launch_caml_main +*/ +char *getenv (const char *name) +{ + Size envlen, i, namelen; + + Assert (envPtr != NULL); + envlen = GetPtrSize (envPtr); + namelen = strlen (name); + i = 0; + do{ + if (!strncmp (envPtr + i, name, namelen) && envPtr [i+namelen] == '='){ + return envPtr + i + namelen + 1; + } + while (envPtr [i] != '\000') ++ i; + ++ i; + }while (i < envlen); + return NULL; +} + + +/*** + "terminfo" stuff: change the style of displayed text to show the + error locations. See also ui_write. +*/ + +value terminfo_setup (value vchan); +value terminfo_backup (value lines); +value terminfo_standout (value start); +value terminfo_resume (value lines); + +#define Good_term_tag 0 + +value terminfo_setup (value vchan) +{ +#pragma unused (vchan) + value result = alloc (1, Good_term_tag); + Field (result, 0) = Val_int (1000000000); + return result; +} + +value terminfo_backup (value lines) +{ + long i, j; + Handle txt; + char *p; + WEReference we = WinGetWE (winToplevel); + + Assert (we != NULL); + txt = WEGetText (we); + p = (char *) *txt; + j = wintopfrontier - 1; + + for (i = 0; i < Long_val (lines); i++){ + Assert (p[j] == '\n'); + do{ --j; }while (p[j] != '\n'); + } + Assert (p[j] == '\n'); + error_curpos = j + 1; + erroring = 1; + error_anchor = -1; + return Val_unit; +} + +value terminfo_standout (value start) +{ + if (Bool_val (start) && error_anchor == -1){ + error_anchor = error_curpos; + }else if (!Bool_val (start) && error_anchor != -1){ + long selstart, selend; + WEReference we = WinGetWE (winToplevel); + short readonly; + + Assert (we != NULL); + WEGetSelection (&selstart, &selend, we); + readonly = WEFeatureFlag (weFReadOnly, weBitTest, we); + if (readonly) WEFeatureFlag (weFReadOnly, weBitClear, we); + WESetSelection (error_anchor, error_curpos, we); + WESetStyle (weDoFont + weDoFace + weDoSize + weDoColor + weDoReplaceFace, + &prefs.errors, we); + if (readonly) WEFeatureFlag (weFReadOnly, weBitSet, we); + WESetSelection (selstart, selend, we); + error_anchor = -1; + } + return Val_unit; +} + +value terminfo_resume (value lines) +{ +#pragma unused (lines) + erroring = 0; + return Val_unit; +} diff --git a/maccaml/graph.c b/maccaml/graph.c new file mode 100644 index 000000000..58290b2ce --- /dev/null +++ b/maccaml/graph.c @@ -0,0 +1,1115 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "alloc.h" +#include "callback.h" +#include "fail.h" +#include "memory.h" +#include "mlvalues.h" +#include "signals.h" +#include "str.h" + +#include "main.h" /* Include main.h last or Assert will not work. */ + + +/* The off-screen buffer that holds the contents of the graphics + arena. */ +static GWorldPtr gworld = NULL; + +/* An arbitrarily large rectangle (for clipping). */ +static Rect maxrect = { -SHRT_MAX, -SHRT_MAX, SHRT_MAX, SHRT_MAX }; + +/* Coordinates (relative to the window) of the top-left corner + of the graphics arena. */ +long x0, y0; + +/* Width and height of the graphics arena. */ +long w0, h0; + +RGBColor fgcolor; + +/* Convert from Caml coordinates to QD coordinates in the off-screen buffer. */ +/* Note: these conversions are self-inverse (see gr_current_point). */ +#define Bx(x) (x) +#define By(y) (h0 - (y)) + +/* Convert from Caml coordinates to QD coordinates in the window. */ +#define Wx(x) ((x) + x0) +#define Wy(y) ((h0 - (y)) + y0) + +/* Convert from QD window coordinates to Caml coordinates. */ +#define Cx(x) ((x) - x0) +#define Cy(y) (h0 - ((y) - y0)) + + +/***********************************************************************/ +/* User interface functions */ +/***********************************************************************/ + +static void GraphUpdateGW (void) +{ + Rect r; + WStatusH st = WinGetStatus (winGraphics); + + Assert (st != NULL); + Assert (gworld != NULL); + WELongRectToRect (&(*st)->destrect, &r); + OffsetRect (&r, winGraphics->portRect.left, winGraphics->portRect.top); + UpdateGWorld (&gworld, 0, &r, NULL, NULL, clipPix); +} + +void GraphNewSizePos (void) +{ + GraphUpdateGW (); +} + +void GraphUpdate (void) +{ + Rect r, src, dst; + Boolean good; + WStatusH st = WinGetStatus (winGraphics); + RGBColor forecolor, backcolor; + + Assert (st != NULL); + GraphUpdateGW (); + good = LockPixels (GetGWorldPixMap (gworld)); Assert (good); + WELongRectToRect (&(*st)->destrect, &r); + WELongRectToRect (&(*st)->viewrect, &dst); + src = dst; + OffsetRect (&src, -r.left, -r.top); + GetBackColor (&backcolor); + GetForeColor (&forecolor); + BackColor (whiteColor); + ForeColor (blackColor); + CopyBits (&((GrafPtr) gworld)->portBits, &((GrafPtr) winGraphics)->portBits, + &src, &dst, srcCopy, NULL); + RGBBackColor (&backcolor); + RGBForeColor (&forecolor); + UnlockPixels (GetGWorldPixMap (gworld)); +} + +/* All scrolling of the graphics window must go through this function + so it can update the coordinates x0 and y0, and the pen location. */ +void GraphScroll (long dx, long dy) +{ + Rect r; + RgnHandle update = NewRgn (); + WStatusH st = WinGetStatus (winGraphics); + Point p; + + Assert (st != NULL); + WELongRectToRect (&(*st)->viewrect, &r); + ScrollRect (&r, dx, dy, update); + WEOffsetLongRect (&(*st)->destrect, dx, dy); + SetClip (update); + GraphUpdate (); + ClipRect (&maxrect); + DisposeRgn (update); + + x0 += dx; + y0 += dy; + GetPen (&p); + MoveTo (p.h + dx, p.v + dy); +} + +/* keyboard event queue */ +typedef struct { + short mouse_x, mouse_y; + short button; + char key; +} GraphEvent; + +#define Queue_length 256 +static GraphEvent graphQ [Queue_length]; +static long graphQhd = 0, graphQtl = 0; + +#define Incr(x){ \ + ++ (x); \ + if ((x) >= Queue_length) (x) = 0; \ +} + +static void GraphQPush (GraphEvent *evt) +{ + graphQ [graphQtl] = *evt; + Incr (graphQtl); + if (graphQtl == graphQhd) { Incr (graphQhd); } +} + +static GraphEvent *GraphQPop (void) +{ + if (graphQhd == graphQtl){ + return NULL; + }else{ + GraphEvent *result = &graphQ [graphQhd]; + Incr (graphQhd); + return result; + } +} + +static GraphEvent *GraphQHead (void) +{ + if (graphQhd == graphQtl){ + return NULL; + }else{ + return &graphQ [graphQhd]; + } +} + +#define Button_down_val 0 +#define Button_up_val 1 +#define Key_pressed_val 2 +#define Mouse_motion_val 3 +#define Poll_val 4 + +/* The latest mouse event that took place in the graphics window. */ +static struct { + int valid; + long type; + long mouse_x; + long mouse_y; +} latestevent; + +void GraphGotEvent (EventRecord *evt) +{ + GrafPtr saveport; + Point pt = evt->where; + GraphEvent grevt; + + GetPort (&saveport); + SetPort (winGraphics); + GlobalToLocal (&pt); + SetPort (saveport); + + + switch (evt->what){ + case mouseDown: + latestevent.type = Button_down_val; + latestevent.valid = 1; + latestevent.mouse_x = Cx (pt.h); + latestevent.mouse_y = Cy (pt.v); + break; + case mouseUp: + latestevent.type = Button_up_val; + latestevent.valid = 1; + latestevent.mouse_x = Cx (pt.h); + latestevent.mouse_y = Cy (pt.v); + break; + case keyDown: + case autoKey: + grevt.mouse_x = Cx (pt.h); + grevt.mouse_y = Cy (pt.v); + grevt.button = evt->modifiers & btnState; + grevt.key = evt->message & charCodeMask; + GraphQPush (&grevt); + break; + default: Assert (0); + } +} + +/***********************************************************************/ +/* Primitives for the graphics library */ +/***********************************************************************/ + +value gr_open_graph (value vgeometry); +value gr_close_graph (value unit); +value gr_sigio_signal (value unit); +value gr_sigio_handler (value unit); +value gr_clear_graph (value unit); +value gr_size_x (value unit); +value gr_size_y (value unit); +value gr_set_color (value vrgb); +value gr_plot (value vx, value vy); +value gr_point_color (value vx, value vy); +value gr_moveto (value vx, value vy); +value gr_current_point (value unit); +value gr_lineto (value vx, value vy); +value gr_draw_arc (value *argv, int argc); +value gr_draw_arc_nat (value, value, value, value, value, value); +value gr_set_line_width (value vwidth); +value gr_fill_rect (value vx, value vy, value vw, value vh); +value gr_fill_poly (value vpoints); +value gr_fill_arc (value *argv, int argc); +value gr_fill_arc_nat (value, value, value, value, value, value); +value gr_draw_char (value vchr); +value gr_draw_string (value vstr); +value gr_set_font (value vfontname); +value gr_set_text_size (value vsz); +value gr_text_size (value vstr); +value gr_make_image (value varray); +value gr_dump_image (value vimage); +value gr_draw_image (value vimage, value vx, value vy); +value gr_create_image (value vw, value vh); +value gr_blit_image (value vimage, value vx, value vy); +value gr_wait_event (value veventlist); +value gr_sound (value vfreq, value vdur); + + +/**** Ancillary macros and function */ + +/* Drawing off-screen and on-screen simultaneously. The following three + macros must always be used together and in this order. +*/ +/* 1. Begin drawing in the off-screen buffer. */ +#define BeginOff { \ + CGrafPtr _saveport_; \ + GDHandle _savegdev_; \ + Rect _cliprect_; \ + GetGWorld (&_saveport_, &_savegdev_); \ + LockPixels (GetGWorldPixMap (gworld)); \ + SetGWorld ((CGrafPtr) gworld, NULL); + +/* 2. Continue with on-screen drawing. */ +#define On \ + SetGWorld (_saveport_, _savegdev_); \ + UnlockPixels (GetGWorldPixMap (gworld)); \ + SetPort (winGraphics); \ + ScrollCalcGraph (winGraphics, &_cliprect_); \ + ClipRect (&_cliprect_); + +/* 3. Clean up after drawing. */ +#define End \ + ClipRect (&maxrect); \ + SetPort ((GrafPtr) _saveport_); \ +} + +/* Convert a red, green, or blue value from 8 bits to 16 bits. */ +#define RGB8to16(x) ((x) | ((x) << 8)) + +/* Declare and convert x and y from vx and vy. */ +#define XY long x = Long_val (vx), y = Long_val (vy) + + +static value * graphic_failure_exn = NULL; + +static void gr_fail(char *fmt, void *arg) +{ + char buffer[1024]; + + if (graphic_failure_exn == NULL) { + graphic_failure_exn = caml_named_value("Graphics.Graphic_failure"); + if (graphic_failure_exn == NULL){ + invalid_argument("Exception Graphics.Graphic_failure not initialized," + " you must load graphics.cma"); + } + } + sprintf(buffer, fmt, arg); + raise_with_string(*graphic_failure_exn, buffer); +} + +static void gr_check_open (void) +{ + if (winGraphics == NULL) gr_fail("graphic screen not opened", NULL); +} + +/* Max_image_mem is the number of image pixels that can be allocated + in one major GC cycle. The GC will speed up to match this allocation + speed. +*/ +#define Max_image_mem 1000000 /* XXX Should use 20% of total memory */ + +#define Transparent (-1) + +struct grimage { + final_fun f; /* Finalization function */ + long width, height; /* Dimensions of the image */ + GWorldPtr data; /* Pixels */ + GWorldPtr mask; /* Mask for transparent points, or NULL */ +}; + +#define Grimage_wosize \ + ((sizeof (struct grimage) + sizeof (value) - 1) / sizeof (value)) + +static void free_image (value vimage) +{ + struct grimage *im = (struct grimage *) Bp_val (vimage); + + if (im->data != NULL) DisposeGWorld (im->data); + if (im->mask != NULL) DisposeGWorld (im->mask); +} + +static value alloc_image (long w, long h) +{ + value res = alloc_final (Grimage_wosize, free_image, w*h, Max_image_mem); + struct grimage *im = (struct grimage *) Bp_val (res); + Rect r; + QDErr err; + + im->width = w; + im->height = h; + im->mask = NULL; + SetRect (&r, 0, 0, w, h); + err = NewGWorld (&im->data, 32, &r, NULL, NULL, 0); + if (err != noErr){ + im->data = NULL; + gr_fail ("Cannot allocate image (error code %ld)", (void *) err); + } + return res; +} + +static value gr_alloc_int_vect(mlsize_t size) +{ + value res; + mlsize_t i; + + if (size <= Max_young_wosize) { + res = alloc(size, 0); + } else { + res = alloc_shr(size, 0); + } + for (i = 0; i < size; i++) { + Field(res, i) = Val_long(0); + } + return res; +} + +/***********************************************************************/ + +value gr_open_graph (value vgeometry) +{ + int i; + short err; + Rect r; + WStatusH st; + + if (winGraphics == NULL){ + Assert (gworld == NULL); + + i = sscanf (String_val (vgeometry), "%ldx%ld", &w0, &h0); + if (i < 2){ + w0 = 640; + h0 = 480; + } + if (w0 < kMinWindowWidth - kScrollBarWidth - 1){ + w0 = kMinWindowWidth - kScrollBarWidth - 1; + } + if (h0 < kMinWindowHeight - kScrollBarWidth - 1){ + h0 = kMinWindowHeight - kScrollBarWidth - 1; + } + + err = WinOpenGraphics (w0, h0); + if (err != noErr) goto failed; + + x0 = y0 = 0; + + st = WinGetStatus (winGraphics); Assert (st != NULL); + WELongRectToRect (&(*st)->destrect, &r); + OffsetRect (&r, winGraphics->portRect.left, winGraphics->portRect.top); + err = NewGWorld (&gworld, 0, &r, NULL, NULL, 0); + if (err != noErr) goto failed; + + fgcolor.red = fgcolor.green = fgcolor.blue = 0; + } + gr_clear_graph (Val_unit); + gr_moveto (Val_long (0), Val_long (0)); + return Val_unit; + + failed: + if (gworld != NULL){ + DisposeGWorld (gworld); + gworld = NULL; + } + if (winGraphics != NULL) WinCloseGraphics (); + gr_fail ("open_graph failed (error %d)", (void *) (long) err); + return Val_unit; /* not reached */ +} + +value gr_close_graph (value unit) +{ +#pragma unused (unit) + gr_check_open (); + WinCloseGraphics (); + DisposeGWorld (gworld); + gworld = NULL; + return Val_unit; +} + +value gr_sigio_signal (value unit) /* Not used on MacOS */ +{ + return Val_unit; +} + +value gr_sigio_handler (value unit) /* Not used on MacOS */ +{ + return Val_unit; +} + +value gr_clear_graph (value unit) +{ +#pragma unused (unit) + gr_check_open (); + BeginOff + EraseRect (&maxrect); + On + EraseRect (&maxrect); + End + return unit; +} + +value gr_size_x (value unit) +{ +#pragma unused (unit) + gr_check_open (); + return Val_long (w0); +} + +value gr_size_y (value unit) +{ +#pragma unused (unit) + gr_check_open (); + return Val_long (h0); +} + +value gr_set_color (value vrgb) +{ + long rgb = Long_val (vrgb); + + gr_check_open (); + fgcolor.red = RGB8to16 ((rgb >> 16) & 0xFF); + fgcolor.green = RGB8to16 ((rgb >> 8) & 0xFF); + fgcolor.blue = RGB8to16 (rgb & 0xFF); + BeginOff + RGBForeColor (&fgcolor); + On + RGBForeColor (&fgcolor); + End + return Val_unit; +} + +value gr_plot (value vx, value vy) +{ + XY; + + gr_check_open (); + BeginOff + SetCPixel (Bx (x), By (y+1), &fgcolor); + On + SetCPixel (Wx (x), Wy (y+1), &fgcolor); + End + return Val_unit; +} + +value gr_point_color (value vx, value vy) +{ + XY; + RGBColor c; + + gr_check_open (); + if (x < 0 || x >= w0 || y < 0 || y >= h0) return Val_long (-1); + BeginOff + GetCPixel (Bx (x), By (y+1), &c); + On + End + + return Val_long (((c.red & 0xFF00) << 8) + | (c.green & 0xFF00) + | ((c.blue & 0xFF00) >> 8)); +} + +value gr_moveto (value vx, value vy) +{ + XY; + + gr_check_open (); + BeginOff + MoveTo (Bx (x), By (y)); + On + MoveTo (Wx (x), Wy (y)); + End + return Val_unit; +} + +value gr_current_point (value unit) +{ +#pragma unused (unit) + value result = alloc_tuple (2); + Point p; + + gr_check_open (); + BeginOff + GetPen (&p); + On + End + Field (result, 0) = Val_long (Bx (p.h)); + Field (result, 1) = Val_long (By (p.v)); + return result; +} + +value gr_lineto (value vx, value vy) +{ + XY; + + gr_check_open (); + BeginOff + LineTo (Bx (x), By (y)); + On + LineTo (Wx (x), Wy (y)); + End + + return Val_unit; +} + +value gr_draw_arc (value *argv, int argc) +{ + return gr_draw_arc_nat (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); +} + +value gr_draw_arc_nat (value vx, value vy, value vrx, value vry, value va1, + value va2) +{ + XY; + long rx = Long_val (vrx), ry = Long_val (vry); + long a1 = Long_val (va1), a2 = Long_val (va2); + Rect r; + long qda1 = 90 - a1, qda2 = 90 - a2; + + gr_check_open (); + BeginOff + SetRect (&r, Bx (x-rx), By (y+ry), Bx (x+rx), By (y-ry)); + FrameArc (&r, qda1, qda2 - qda1); + On + SetRect (&r, Wx (x-rx), Wy (y+ry), Wx (x+rx), Wy (y-ry)); + FrameArc (&r, qda1, qda2 - qda1); + End + return Val_unit; +} + +value gr_set_line_width (value vwidth) +{ + short width = Int_val (vwidth); + + if (width == 0) width = 1; + gr_check_open (); + BeginOff + PenSize (width, width); + On + PenSize (width, width); + End + return Val_unit; +} + +value gr_fill_rect (value vx, value vy, value vw, value vh) +{ + XY; + long w = Long_val (vw), h = Long_val (vh); + Rect r; + + gr_check_open (); + BeginOff + SetRect (&r, Bx (x), By (y+h), Bx (x+w), By (y)); + PaintRect (&r); + On + SetRect (&r, Wx (x), Wy (y+h), Wx (x+w), Wy (y)); + PaintRect (&r); + End + return Val_unit; +} + +value gr_fill_poly (value vpoints) +{ + long i, n = Wosize_val (vpoints); + PolyHandle p; + + #define Bxx(i) Bx (Field (Field (vpoints, (i)), 0)) + #define Byy(i) By (Field (Field (vpoints, (i)), 1)) + + gr_check_open (); + if (n < 1) return Val_unit; + + p = OpenPoly (); + MoveTo (Bxx (0), Byy (0)); + for (i = 1; i < n; i++) LineTo (Bxx (i), Byy (i)); + ClosePoly (); + BeginOff + PaintPoly (p); + On + OffsetPoly (p, x0, y0); + PaintPoly (p); + End + KillPoly (p); + return Val_unit; +} + +value gr_fill_arc (value *argv, int argc) +{ + return gr_fill_arc_nat (argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); +} + +value gr_fill_arc_nat (value vx, value vy, value vrx, value vry, value va1, + value va2) +{ + XY; + long rx = Long_val (vrx), ry = Long_val (vry); + long a1 = Long_val (va1), a2 = Long_val (va2); + Rect r; + long qda1 = 90 - a1, qda2 = 90 - a2; + + gr_check_open (); + BeginOff + SetRect (&r, Bx (x-rx), By (y+ry), Bx (x+rx), By (y-ry)); + PaintArc (&r, qda1, qda2 - qda1); + On + SetRect (&r, Wx (x-rx), Wy (y+ry), Wx (x+rx), Wy (y-ry)); + PaintArc (&r, qda1, qda2 - qda1); + End + return Val_unit; +} + +value gr_draw_char (value vchr) +{ + char c = Int_val (vchr); + + gr_check_open (); + BeginOff + DrawChar (c); + On + DrawChar (c); + End + return Val_unit; +} + +value gr_draw_string (value vstr) +{ + mlsize_t len = string_length (vstr); + char *str = String_val (vstr); + + gr_check_open (); + if (len > 32767) len = 32767; + BeginOff + DrawText (str, 0, len); + On + DrawText (str, 0, len); + End + return Val_unit; +} + +value gr_set_font (value vfontname) +{ + Str255 pfontname; + short fontnum; + + gr_check_open (); + CopyCStringToPascal (String_val (vfontname), pfontname); + GetFNum (pfontname, &fontnum); + BeginOff + TextFont (fontnum); + On + TextFont (fontnum); + End + return Val_unit; +} + +value gr_set_text_size (value vsz) +{ + short sz = Int_val (vsz); + + gr_check_open (); + BeginOff + TextSize (sz); + On + TextSize (sz); + End + return Val_unit; +} + +value gr_text_size (value vstr) +{ + mlsize_t len = string_length (vstr); + char *str = String_val (vstr); + value result = alloc_tuple (2); + FontInfo info; + long w, h; + + BeginOff + GetFontInfo (&info); + w = TextWidth (str, 0, len); + h = info.ascent + info.descent; + On + End + Field (result, 0) = Val_long (w); + Field (result, 1) = Val_long (h); + return result; +} + +value gr_make_image (value varray) +{ + long height = Wosize_val (varray); + long width; + long x, y; + GWorldPtr w; + value result, line; + long color; + RGBColor qdcolor; + int has_transp = 0; + CGrafPtr saveport; + GDHandle savegdev; + + gr_check_open (); + if (height == 0) return alloc_image (0, 0); + width = Wosize_val (Field (varray, 0)); + for (y = 1; y < height; y++){ + if (Wosize_val (Field (varray, y)) != width){ + gr_fail("make_image: lines of different lengths", NULL); + } + } + + result = alloc_image (width, height); + w = ((struct grimage *) Bp_val (result))->data; + + LockPixels (GetGWorldPixMap (w)); + GetGWorld (&saveport, &savegdev); + SetGWorld ((CGrafPtr) w, NULL); + for (y = 0; y < height; y++){ + line = Field (varray, y); + for (x = 0; x < width; x++){ + color = Long_val (Field (line, x)); + if (color == Transparent) has_transp = 1; + qdcolor.red = ((color >> 16) & 0xFF) | ((color >> 8) & 0xFF00); + qdcolor.green = ((color >> 8) & 0xFF) | (color & 0xFF00); + qdcolor.blue = (color & 0xFF) | ((color << 8) & 0xFF00); + SetCPixel (x, y, &qdcolor); + } + } + UnlockPixels (GetGWorldPixMap (w)); + + if (has_transp){ + Rect r; + QDErr err; + + SetRect (&r, 0, 0, width, height); + err = NewGWorld (&w, 1, &r, NULL, NULL, 0); + if (err != noErr){ + SetGWorld (saveport, savegdev); + gr_fail ("Cannot allocate image (error code %d)", (void *) err); + } + LockPixels (GetGWorldPixMap (w)); + SetGWorld ((CGrafPtr) w, NULL); + EraseRect (&maxrect); + qdcolor.red = qdcolor.green = qdcolor.blue = 0; + for (y = 0; y < height; y++){ + line = Field (varray, y); + for (x = 0; x < width; x++){ + color = Long_val (Field (line, x)); + if (color != Transparent) SetCPixel (x, y, &qdcolor); + } + } + UnlockPixels (GetGWorldPixMap (w)); + ((struct grimage *) Bp_val (result))->mask = w; + } + + SetGWorld (saveport, savegdev); + + return result; +} + +value gr_dump_image (value vimage) +{ + value result = Val_unit; + struct grimage *im = (struct grimage *) Bp_val (vimage); + long width = im->width; + long height = im->height; + long x, y; + GWorldPtr wdata = im->data; + GWorldPtr wmask = im->mask; + CGrafPtr saveport; + GDHandle savegdev; + RGBColor qdcolor; + value line; + + gr_check_open (); + Begin_roots2 (vimage, result); + result = gr_alloc_int_vect (height); + for (y = 0; y < height; y++){ + value v = gr_alloc_int_vect (width); + modify (&Field (result, y), v); + } + End_roots (); + GetGWorld (&saveport, &savegdev); + LockPixels (GetGWorldPixMap (wdata)); + SetGWorld (wdata, NULL); + for (y = 0; y < height; y++){ + line = Field (result, y); + for (x = 0; x < width; x++){ + GetCPixel (x, y, &qdcolor); + Field (line, x) = Val_long (((qdcolor.red & 0xFF00) << 8) + | (qdcolor.green & 0xFF00) + | ((qdcolor.blue & 0xFF00) >> 8)); + } + } + UnlockPixels (GetGWorldPixMap (wdata)); + if (wmask != NULL){ + LockPixels (GetGWorldPixMap (wmask)); + SetGWorld (wmask, NULL); + for (y = 0; y < height; y++){ + line = Field (result, y); + for (x = 0; x < width; x++){ + if (!GetPixel (x, y)) Field (line, x) = Val_long (Transparent); + } + } + UnlockPixels (GetGWorldPixMap (wmask)); + } + SetGWorld (saveport, savegdev); + return result; +} + +value gr_draw_image (value vimage, value vx, value vy) +{ + XY; + struct grimage *im = (struct grimage *) Bp_val (vimage); + RGBColor forecolor, backcolor; + Rect srcrect, dstrect; + + SetRect (&srcrect, 0, 0, im->width, im->height); + if (im->mask != NULL){ + LockPixels (GetGWorldPixMap (im->data)); + LockPixels (GetGWorldPixMap (im->mask)); + BeginOff + SetRect (&dstrect, Bx (x), By (y+im->height), Bx (x+im->width), By (y)); + GetBackColor (&backcolor); + GetForeColor (&forecolor); + BackColor (whiteColor); + ForeColor (blackColor); + CopyMask (&((GrafPtr) im->data)->portBits, + &((GrafPtr) im->mask)->portBits, + &((GrafPtr) gworld)->portBits, + &srcrect, &srcrect, &dstrect); + RGBBackColor (&backcolor); + RGBForeColor (&forecolor); + On + SetRect (&dstrect, Wx (x), Wy (y+im->height), Wx (x+im->width), Wy (y)); + GetBackColor (&backcolor); + GetForeColor (&forecolor); + BackColor (whiteColor); + ForeColor (blackColor); + CopyMask (&((GrafPtr) im->data)->portBits, + &((GrafPtr) im->mask)->portBits, + &((GrafPtr) winGraphics)->portBits, + &srcrect, &srcrect, &dstrect); + RGBBackColor (&backcolor); + RGBForeColor (&forecolor); + End + UnlockPixels (GetGWorldPixMap (im->data)); + UnlockPixels (GetGWorldPixMap (im->mask)); + }else{ + LockPixels (GetGWorldPixMap (im->data)); + BeginOff + SetRect (&dstrect, Bx (x), By (y+im->height), Bx (x+im->width), By (y)); + GetBackColor (&backcolor); + GetForeColor (&forecolor); + BackColor (whiteColor); + ForeColor (blackColor); + CopyBits (&((GrafPtr) im->data)->portBits, &((GrafPtr) gworld)->portBits, + &srcrect, &dstrect, srcCopy, NULL); + RGBBackColor (&backcolor); + RGBForeColor (&forecolor); + On + SetRect (&dstrect, Wx (x), Wy (y+im->height), Wx (x+im->width), Wy (y)); + GetBackColor (&backcolor); + GetForeColor (&forecolor); + BackColor (whiteColor); + ForeColor (blackColor); + CopyBits (&((GrafPtr) im->data)->portBits, + &((GrafPtr) winGraphics)->portBits, &srcrect, &dstrect, srcCopy, + NULL); + RGBBackColor (&backcolor); + RGBForeColor (&forecolor); + End + UnlockPixels (GetGWorldPixMap (im->data)); + } + return Val_unit; +} + +value gr_create_image (value vw, value vh) +{ + return alloc_image (Long_val (vw), Long_val (vh)); +} + +value gr_blit_image (value vimage, value vx, value vy) +{ + XY; + struct grimage *im = (struct grimage *) Bp_val (vimage); + Rect srcrect, dstrect, worldrect; + CGrafPtr saveport; + GDHandle savegdev; + + SetRect (&worldrect, 0, 0, w0, h0); + SetRect (&srcrect, Bx (x), By (y+im->height), Bx (x+im->width), By (y)); + SectRect (&srcrect, &worldrect, &srcrect); + dstrect = srcrect; + OffsetRect (&dstrect, -Bx (x), -By (y+im->height)); + + LockPixels (GetGWorldPixMap (im->data)); + LockPixels (GetGWorldPixMap (gworld)); + GetGWorld (&saveport, &savegdev); + SetGWorld (im->data, NULL); + BackColor (whiteColor); + ForeColor (blackColor); + CopyBits (&((GrafPtr) gworld)->portBits, &((GrafPtr) im->data)->portBits, + &srcrect, &dstrect, srcCopy, NULL); + SetGWorld (saveport, savegdev); + UnlockPixels (GetGWorldPixMap (im->data)); + UnlockPixels (GetGWorldPixMap (gworld)); + return Val_unit; +} + +static long oldx = SHRT_MAX - 1, oldy = SHRT_MAX - 1; + +value gr_wait_event (value veventlist) +{ + int askmousedown = 0, askmouseup = 0, askkey = 0, askmotion = 0, askpoll = 0; + long mouse_x, mouse_y; + int button, keypressed; + char key = 0; + GraphEvent *evt; + GrafPtr saveport; + value result; + Point pt; + + gr_check_open(); + GetPort (&saveport); + SetPort (winGraphics); + + while (veventlist != Val_int (0)) { + switch (Int_val(Field (veventlist, 0))) { + case Button_down_val: askmousedown = 1; break; + case Button_up_val: askmouseup = 1; break; + case Key_pressed_val: askkey = 1; break; + case Mouse_motion_val: askmotion = 1; break; + case Poll_val: askpoll = 1; break; + } + veventlist = Field (veventlist, 1); + } + + if (askpoll){ + GetMouse (&pt); + mouse_x = Cx (pt.h); + mouse_y = Cy (pt.v); + button = Button (); + evt = GraphQHead (); + if (evt != NULL) { + keypressed = 1; + key = evt->key; + }else{ + keypressed = 0; + } + goto gotevent; + } + if (askkey && (evt = GraphQPop ()) != NULL){ + mouse_x = evt->mouse_x; + mouse_y = evt->mouse_y; + button = evt->button; + keypressed = 1; + key = evt->key; + goto gotevent; + } + /* Change from Caml coordinates to global QD coordinates. */ + pt.h = Wx (oldx); + pt.v = Wy (oldy); + LocalToGlobal (&pt); + /* Restore the grafport now because GetAndProcessEvents may longjmp + directly out of here. + */ + SetPort (saveport); + while (1){ + latestevent.valid = 0; + enter_blocking_section (); + Caml_working (0); + GetAndProcessEvents (askmotion ? waitMove : waitEvent, pt.h, pt.v); + Caml_working (1); + leave_blocking_section (); + if (askkey && (evt = GraphQPop ()) != NULL){ + mouse_x = evt->mouse_x; + mouse_y = evt->mouse_y; + button = evt->button; + keypressed = 1; + key = evt->key; + goto gotevent; + } + if (latestevent.valid){ + if (askmousedown && latestevent.type == Button_down_val){ + mouse_x = latestevent.mouse_x; + mouse_y = latestevent.mouse_y; + button = 1; + keypressed = 0; + goto gotevent; + } + if (askmouseup && latestevent.type == Button_up_val){ + mouse_x = latestevent.mouse_x; + mouse_y = latestevent.mouse_y; + button = 0; + keypressed = 0; + goto gotevent; + } + } + if (askmotion){ + SetPort (winGraphics); + GetMouse (&pt); + SetPort (saveport); + mouse_x = Cx (pt.h); + mouse_y = Cy (pt.v); + if (mouse_x != oldx || mouse_y != oldy){ + button = Button (); + keypressed = 0; + goto gotevent; + } + } + } + gotevent: + oldx = mouse_x; + oldy = mouse_y; + + result = alloc_tuple (5); + Field (result, 0) = Val_int (mouse_x); + Field (result, 1) = Val_int (mouse_y); + Field (result, 2) = Val_bool (button); + Field (result, 3) = Val_bool (keypressed); + Field (result, 4) = Val_int (key); + return result; +} + +value gr_sound (value vfreq, value vdur) +{ + long freq = Long_val (vfreq); + long dur = Long_val (vdur); + long scale; + Handle h; + OSErr err; + + if (dur <= 0 || freq <= 0) return Val_unit; + if (dur > 5000) dur = 5000; + if (freq > 20000) gr_fail ("sound: frequency is too high", NULL); + + if (freq > 11025) scale = 2; + else if (freq > 5513) scale = 4; + else if (freq > 1378) scale = 8; + else if (freq > 345) scale = 32; + else if (freq > 86) scale = 128; + else scale = 512; + + h = GetResource ('snd ', 1000 + scale); + if (h == NULL){ + gr_fail ("sound: resource error (code = %ld)", (void *) (long) ResError ()); + } + err = HandToHand (&h); + if (err != noErr) gr_fail ("sound: out of memory", NULL); + *(unsigned short *)((*h)+kDurationOffset) = dur * 2; + Assert (scale * freq < 0x10000); + *(unsigned short *)((*h)+kSampleRateOffset) = scale * freq; + HLock (h); + err = SndPlay (NULL, (SndListHandle) h, false); + HUnlock (h); + if (err != noErr){ + gr_fail ("sound: cannot play sound (error code %ld)", (void *) (long) err); + } + + return Val_unit; +} diff --git a/maccaml/graphprims b/maccaml/graphprims new file mode 100644 index 000000000..adb50c532 --- /dev/null +++ b/maccaml/graphprims @@ -0,0 +1,32 @@ +gr_open_graph +gr_close_graph +gr_sigio_signal +gr_sigio_handler +gr_clear_graph +gr_size_x +gr_size_y +gr_set_color +gr_plot +gr_point_color +gr_moveto +gr_current_point +gr_lineto +gr_draw_arc_nat +gr_draw_arc +gr_set_line_width +gr_fill_rect +gr_fill_poly +gr_fill_arc_nat +gr_fill_arc +gr_draw_char +gr_draw_string +gr_set_font +gr_set_text_size +gr_text_size +gr_make_image +gr_dump_image +gr_draw_image +gr_create_image +gr_blit_image +gr_wait_event +gr_sound diff --git a/maccaml/lcontrols.c b/maccaml/lcontrols.c new file mode 100644 index 000000000..745e15ce6 --- /dev/null +++ b/maccaml/lcontrols.c @@ -0,0 +1,246 @@ +/* + WASTE Demo Project: + Macintosh Controls with Long Values + + Copyright © 1993-1996 Marco Piovanelli + All Rights Reserved + + C port by John C. Daub +*/ + +/*************************************************************************** + This file is not subject to the O'Caml licence. + It is a slightly modified version of "LongControls.c" from + the WASTE Demo source (version 1.2). + ***************************************************************************/ +/* $Id$ */ + +#ifndef __CONTROLS__ +#include <Controls.h> +#endif + +#ifndef __FIXMATH__ +#include <FixMath.h> +#endif + +#ifndef __TOOLUTILS__ +#include <ToolUtils.h> +#endif + +#include "main.h" /* The change */ +#define BSL(A, B) (((long) (A)) << (B)) /* is here */ + + +// long control auxiliary record used for keeping long settings +// a handle to this record is stored in the reference field of the control record + +struct LCAuxRec +{ + long value; // long value + long min; // long min + long max; // long max +}; +typedef struct LCAuxRec LCAuxRec, *LCAuxPtr, **LCAuxHandle; + + +OSErr LCAttach( ControlRef control ) +{ + Handle aux; + LCAuxPtr pAux; + + /* allocate the auxiliary record that will hold long settings */ + + if ( ( aux = NewHandleClear( sizeof( LCAuxRec ) ) ) == nil ) + { + return MemError( ); + } + + /* store a handle to the auxiliary record in the contrlRfCon field */ + + SetControlReference( control, (long) aux ); + + /* copy current control settings into the auxiliary record */ + + pAux = * (LCAuxHandle) aux; + pAux->value = GetControlValue( control ); + pAux->min = GetControlMinimum( control ); + pAux->max = GetControlMaximum( control ); + + return noErr; +} + +void LCDetach( ControlRef control ) +{ + Handle aux; + + if ( ( aux = (Handle) GetControlReference( control ) ) != nil ) + { + SetControlReference( control, 0L ); + DisposeHandle( aux ); + } +} + +void LCSetValue( ControlRef control, long value ) +{ + LCAuxPtr pAux; + short controlMin, controlMax, newControlValue; + + pAux = * (LCAuxHandle) GetControlReference( control ); + + /* make sure value is in the range min...max */ + + if ( value < pAux->min ) + { + value = pAux->min; + } + if ( value > pAux->max ) + { + value = pAux->max; + } + + /* save value in auxiliary record */ + + pAux->value = value; + + /* calculate new thumb position */ + + controlMin = GetControlMinimum( control ); + controlMax = GetControlMaximum( control ); + newControlValue = controlMin + FixRound( FixMul ( FixDiv( value - pAux->min, + pAux->max - pAux->min), BSL(controlMax - controlMin, 16 ))); + + /* do nothing if the thumb position hasn't changed */ + + if ( newControlValue != GetControlValue(control) ) + { + SetControlValue( control, newControlValue ); + } +} + +void LCSetMin( ControlRef control, long min ) +{ + LCAuxPtr pAux; + + pAux = * (LCAuxHandle) GetControlReference( control ); + + /* make sure min is less than or equal to max */ + + if ( min > pAux->max ) + { + min = pAux->max; + } + + /* save min in auxiliary record */ + + pAux->min = min; + + /* set control minimum to min or SHRT_MIN, whichever is greater */ + + SetControlMinimum( control, ( min >= SHRT_MIN ) ? min : SHRT_MIN ); + + /* reset value */ + + LCSetValue( control, pAux->value ); +} + +void LCSetMax( ControlRef control, long max ) +{ + LCAuxPtr pAux; + + pAux = * (LCAuxHandle) GetControlReference( control ); + + /* make sure max is greater than or equal to min */ + + if ( max < pAux->min ) + { + max = pAux->min; + } + + /* save max in auxiliary record */ + + pAux->max = max; + + /* set control maximum to max or SHRT_MAX, whichever is less */ + + SetControlMaximum( control, ( max <= SHRT_MAX ) ? max : SHRT_MAX ); + + /* reset value */ + + LCSetValue( control, pAux->value ); +} + +/* In each of these LCGetXXX() functions, there are 2 ways listed to do things. They are + both the same thing and perform the same stuff, just one is easier to read than the + other (IMHO). I asked Marco about it and he gave me the shorter code (what's commented + in each function) and gave me this explanation: + + This version [the commented code] yields smaller and faster code + (try disassembling both versions if you wish), but some people may + find it somewhat harder to read. + + I agree with Marco that his code is better overall, but in the interest of readabilty + (since this demo is a learning tool), I left my code in and put Marco's in commented + out. Pick whichever you'd like to use. +*/ + +long LCGetValue( ControlRef control ) +{ + LCAuxPtr pAux; + + pAux = *((LCAuxHandle)GetControlReference( control )); + + return pAux->value; + +// this is Marco's code. Remember, this is a little harder to read, but overall +// yields tighter code. + +// return (* (LCAuxHandle) GetControlReference(control)) -> value; + +} + +long LCGetMin( ControlRef control ) +{ + LCAuxPtr pAux; + + pAux = *((LCAuxHandle)GetControlReference( control )); + + return pAux->min; + +// this is Marco's code. Remember, this is a little harder to read, but overall +// yields tighter code. + +// return (* (LCAuxHandle)GetControlReference(control)) -> min; + +} + +long LCGetMax( ControlRef control ) +{ + LCAuxPtr pAux; + + pAux = *((LCAuxHandle)GetControlReference( control )); + + return pAux->max; + +// this is Marco's code. Remember, this is a little harder to read, but overall +// yields tighter code. + +// return (* (LCAuxHandle)GetControlReference(control)) -> max; + +} + +void LCSynch( ControlRef control ) +{ + LCAuxPtr pAux; + short controlMin, controlMax, controlValue; + + controlMin = GetControlMinimum( control ); + controlMax = GetControlMaximum( control ); + controlValue = GetControlValue( control ); + pAux = * (LCAuxHandle) GetControlReference( control ); + + /* calculate new long value */ + + pAux->value = pAux->min + FixMul( FixRatio ( controlValue - controlMin, + controlMax - controlMin), pAux->max - pAux->min ); +} + diff --git a/maccaml/lib.c b/maccaml/lib.c new file mode 100644 index 000000000..e5f71ffd3 --- /dev/null +++ b/maccaml/lib.c @@ -0,0 +1,33 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +/* These are declared in TextUtils.h but not implemented in Apple's + libraries ?! +*/ + +void CopyPascalStringToC (ConstStr255Param src, char *dst) +{ + strncpy (dst, (char *) src + 1, src[0]); + dst [src[0]] = '\000'; +} + +void CopyCStringToPascal (const char *src, Str255 dst) +{ + int l = strlen (src); + + l = l > 255 ? 255 : l; + dst [0] = l; + strncpy ((char *) dst + 1, src, l); +} diff --git a/maccaml/main.c b/maccaml/main.c new file mode 100644 index 000000000..8f1a2908b --- /dev/null +++ b/maccaml/main.c @@ -0,0 +1,130 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +QDGlobals qd; +int gHasDragAndDrop = 0; +int gHasPowerManager = 0; +int quit_requested = 0; +int launch_toplevel_requested = 0; + +static OSErr Initialise (void) +{ + long gestval; + int i; + OSErr err; + + SetApplLimit (GetApplLimit () - kExtraStackSpace); + MaxApplZone (); + for (i = 0; i < kMoreMasters; i++) MoreMasters (); + InitGraf (&qd.thePort); + InitFonts (); + InitWindows (); + InitMenus (); + TEInit (); + InitDialogs (nil); + InitCursor (); + FlushEvents (everyEvent, 0); + + /* Unload the clipboard to disk if it's too big. */ + if (InfoScrap ()->scrapSize > kScrapThreshold) UnloadScrap (); + + /* Check for system 7. */ + if (Gestalt (gestaltSystemVersion, &gestval) != noErr + || gestval < kMinSystemVersion){ + InitCursor (); + StopAlert (kAlertNeedSys7, NULL); + ExitToShell (); + } + + /* Check for 32-bit color QuickDraw. */ + if (Gestalt (gestaltQuickdrawVersion, &gestval) != noErr + || gestval < gestalt32BitQD){ + InitCursor (); + StopAlert (kAlertNeed32BitQD, NULL); + ExitToShell (); + } + + /* Check for Drag Manager. */ + if (Gestalt (gestaltDragMgrAttr, &gestval) == noErr + && (gestval & (1 << gestaltDragMgrPresent)) + && (&NewDrag != NULL)){ + gHasDragAndDrop = 1; + } + + /* Check for Power Manager. */ + if (Gestalt (gestaltPowerMgrAttr, &gestval) == noErr + && (gestval & (1 << gestaltPMgrExists))){ + gHasPowerManager = 1; + } + + err = InitialiseErrors (); + if (err != noErr) goto problem; + + if (gHasDragAndDrop){ + err = InstallDragHandlers (); + if (err != noErr) goto problem; + } + + err = InitialiseEvents (); + if (err != noErr) goto problem; + + err = InitialiseMenus (); + if (err != noErr) goto problem; + + err = InitialiseScroll (); + if (err != noErr) goto problem; + + err = InitialiseWindows (); + if (err != noErr) goto problem; + + err = InitialiseModalFilter (); + if (err != noErr) goto problem; + + ReadPrefs (); + + return noErr; + + problem: return err; +} + +static void Finalise (void) +{ + if (gHasDragAndDrop) RemoveDragHandlers (); + WritePrefs (); +} + +void main (void) +{ + OSErr err; + + err = Initialise (); + if (err != noErr) ExitApplication (); + + while (1){ + GetAndProcessEvents (waitEvent, 0, 0); + if (launch_toplevel_requested){ + err = launch_caml_main (); /* does not return */ + if (err != noErr) ErrorAlertGeneric (err); + } + } + ExitApplication (); +} + +void ExitApplication (void) +{ + Caml_working (0); + Finalise (); + ExitToShell (); +} diff --git a/maccaml/main.h b/maccaml/main.h new file mode 100644 index 000000000..884a97326 --- /dev/null +++ b/maccaml/main.h @@ -0,0 +1,225 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1997 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <limits.h> +#include <signal.h> +#include <stdio.h> +#include <string.h> + +#include <AERegistry.h> +#include <AppleEvents.h> +#include <Controls.h> +#include <Devices.h> +#include <Dialogs.h> +#include <DiskInit.h> +#include <Drag.h> +#include <Finder.h> +#include <FixMath.h> +#include <Folders.h> +#include <Fonts.h> +#include <Gestalt.h> +#include <LowMem.h> +#include <MacWindows.h> +#include <Menus.h> +#include <Power.h> +#include <Processes.h> +#include <QDOffscreen.h> +#include <QuickDraw.h> +#include <Resources.h> +#include <Scrap.h> +#include <Script.h> +#include <SegLoad.h> +#include <Sound.h> +#include <StandardFile.h> +#include <Strings.h> +#include <TextUtils.h> +#include <ToolUtils.h> +#include <Types.h> + +#include ":WASTE-1.2:WASTE C/C++ Headers:WASTE.h" + +#include "constants.h" + +#if DEBUG +#define Assert(cond) if (!(cond)) assert_failure (#cond, __FILE__, __LINE__) +#else +#define Assert(cond) +#endif + +/* Vertical and Horizontal */ +#define V 0 +#define H 1 + +typedef struct WStatus { + int kind; + short datarefnum; /* window's file (data fork) */ + short resrefnum; /* window's file (resource fork) or -1 */ + int canwritesel; /* selection is writable */ + int dirty; /* has something to revert */ + unsigned long basemodcount; + int hascontents; /* has something to save */ + long line_height; + ControlHandle scrollbars [2]; + LongRect viewrect, destrect; /* view and dest for the graphics window */ + WEHandle we; +} **WStatusH; + +typedef enum { closingWindow = 0, closingApp } ClosingOption; +typedef enum { noWait = 0, waitMove, waitEvent } WaitEventOption; + +#define PREF_VERSION 2 +/* Increment PREF_VERSION at each change in struct prefs. */ +struct prefs { + long version; + int asksavetop; + Rect toppos; + Rect graphpos; + Rect clippos; + TextStyle text; + TextStyle unread; + TextStyle input; + TextStyle output; + TextStyle errors; +}; + +/* aboutbox.c */ +void OpenAboutBox (void); +void CloseAboutBox (WindowPtr w); +void DrawAboutIcon (void); + +/* appleevents.c */ +OSErr InstallAEHandlers (void); + +/* clipboard.c */ +void ClipShow (void); +void ClipClose (void); +void ClipChanged (void); + +/* drag.c */ +OSErr InstallDragHandlers (void); +OSErr RemoveDragHandlers (void); + +/* errors.c */ +void assert_failure (char *condition, char *file, int line); +void XXX (void); +void ErrorAlert (short msg1, Str255 bufmsg2, short msg3, OSErr err); +void ErrorAlertCantOpen (Str255 filename, OSErr err); +void ErrorAlertGeneric (OSErr err); +OSErr InitialiseErrors (void); + +/* events.c */ +extern UInt32 evtSleep; +void GetAndProcessEvents (WaitEventOption wait, short oldx, short oldy); +OSErr InitialiseEvents (void); +extern AEIdleUPP ProcessEventUPP; + +/* files.c */ +OSErr FileDoClose (WindowPtr w, ClosingOption close); +void FileDoGetOpen (void); +void FileNew (void); +OSErr FileOpen (FSSpec *filespec); +void FileRevert (WindowPtr w); +OSErr FileDoSave (WindowPtr w, int saveasflag); + +/* glue.c */ +extern int caml_at_work; +void Caml_working (int newstate); +void GlueInterrupt (void); +OSErr launch_caml_main (void); + +/* graph.c */ +void GraphGotEvent (EventRecord *evt); +void GraphNewSizePos (void); +void GraphScroll (long dx, long dy); +void GraphUpdate (void); + +/* lcontrols.c */ +OSErr LCAttach( ControlRef ); +void LCDetach( ControlRef ); +void LCSetValue( ControlRef, long ); +void LCSetMin( ControlRef, long ); +void LCSetMax( ControlRef, long ); +long LCGetValue( ControlRef ); +long LCGetMin( ControlRef ); +long LCGetMax( ControlRef ); +void LCSynch( ControlRef ); + +/* main.c */ +extern int gHasDragAndDrop; +extern int gHasPowerManager; +extern int quit_requested; +extern int launch_toplevel_requested; +void ExitApplication (void); + +/* memory.c */ +OSErr AllocHandle (Size size, Handle *result); + +/* menus.c */ +void DoMenuChoice (long item, EventModifiers mods); +OSErr DoQuit (void); +OSErr InitialiseMenus (void); +OSErr MenuWinAdd (WindowPtr w); +void MenuWinRemove (WindowPtr w); +void UpdateMenus (void); + +/* misc.c */ +void LocalToGlobalRect (Rect *r); + +/* modalfilter.c */ +extern short modalkeys; +extern ModalFilterUPP myModalFilterUPP; +OSErr InitialiseModalFilter (void); + +/* prefs.c */ +extern struct prefs prefs; +void ReadPrefs (void); +void WritePrefs (void); + +/* scroll.c */ +extern WEScrollUPP scrollFollowUPP; +void AdjustScrollBars (WindowPtr w); +OSErr InitialiseScroll (void); +int ScrollAtEnd (WindowPtr w); +void ScrollCalcText (WindowPtr w, Rect *r); +void ScrollCalcGraph (WindowPtr w, Rect *r); +void ScrollDoClick (WindowPtr w, Point where, EventModifiers mods); +void ScrollNewSize (WindowPtr w); +void ScrollToEnd (WindowPtr w); + +/* windows.c */ +extern WindowPtr winToplevel; +extern WindowPtr winGraphics; +extern long wintopfrontier; +OSErr InitialiseWindows (void); +void WinActivateDeactivate (int activate, WindowPtr w); +void WinAdvanceTopFrontier (long length); +OSErr WinAllocStatus (WindowPtr w); +void WinCloseGraphics (void); +void WinCloseToplevel (void); +void WinDoContentClick (EventRecord *e, WindowPtr w); +OSErr WinDoClose (ClosingOption closing, WindowPtr w); +void WinDoDrag (Point where, WindowPtr w); +void WinDoGrow (Point where, WindowPtr w); +void WinDoIdle (WindowPtr w); +void WinDoKey (WindowPtr w, short chr, EventRecord *e); +void WinDoZoom (WindowPtr w, short partCode); +WStatusH WinGetStatus (WindowPtr w); +WEHandle WinGetWE (WindowPtr w); +int WinGetKind (WindowPtr w); +WindowPtr WinOpenDocument (StringPtr title); +OSErr WinOpenGraphics (long width, long height); +OSErr WinOpenToplevel (void); +void WinClipboardStdState (Rect *r); +void WinToplevelStdState (Rect *r); +void WinUpdate (WindowPtr w); +void WinUpdateStatus (WindowPtr w); diff --git a/maccaml/memory.c b/maccaml/memory.c new file mode 100644 index 000000000..e62c4c9c1 --- /dev/null +++ b/maccaml/memory.c @@ -0,0 +1,29 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +/* Allocate from application memory or from Multifinder memory; + always leave at least kMinimumMemory free in application memory. +*/ +OSErr AllocHandle (Size size, Handle *result) +{ + OSErr err; + + if (FreeMem () >= size + kMinimumMemory){ + *result = NewHandle (size); + err = MemError (); + } + if (err != noErr) *result = TempNewHandle (size, &err); + return err; +} diff --git a/maccaml/menus.c b/maccaml/menus.c new file mode 100644 index 000000000..aec0e38cf --- /dev/null +++ b/maccaml/menus.c @@ -0,0 +1,341 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +static void DoAppleChoice (short item, EventModifiers mods) +{ + if (item == kItemAbout){ + OpenAboutBox (); + }else{ + Str255 deskAccName; + GetMenuItemText (GetMenuHandle (kMenuApple), item, deskAccName); + OpenDeskAcc (deskAccName); + } +} + +OSErr DoQuit () +{ + WindowPtr w; + OSErr err; + + while (1){ + w = FrontWindow (); + while (1){ + if (w == NULL) goto done; + if (GetWindowGoAwayFlag (w) && w != winGraphics) break; + w = GetNextWindow (w); + } + err = WinDoClose (closingApp, w); + if (err != noErr) return err; + } + done: + if (winGraphics != NULL) WinCloseGraphics (); + WinCloseToplevel (); + quit_requested = 1; + return noErr; +} + +static void DoFileChoice (short item, EventModifiers mods) +{ + WindowPtr w = FrontWindow (); + + switch (item){ + case kItemNew: + FileNew (); + break; + case kItemOpen: + FileDoGetOpen (); + break; + case kItemClose: + WinDoClose (closingWindow, w); + break; + case kItemSave: + FileDoSave (w, 0); + break; + case kItemSaveAs: + FileDoSave (w, 1); + break; + case kItemRevert: + FileRevert (w); + break; + case kItemPageSetup: + XXX (); + break; + case kItemPrint: + XXX (); + break; + case kItemQuit: + DoQuit (); + break; + default: Assert (0); + } +} + +static void DoEditChoice (short item, EventModifiers mods) +{ + WindowPtr w = FrontWindow (); + WEReference we = WinGetWE (w); + + switch (item){ + case kItemUndo: + WEUndo (we); + break; + case kItemCut: + WECut (we); + ClipChanged (); + break; + case kItemCopy: + WECopy (we); + ClipChanged (); + break; + case kItemPaste: + if (w == winToplevel){ + long selstart, selend; + WEGetSelection (&selstart, &selend, we); + if (selstart == wintopfrontier && selend == selstart){ + WESetStyle (weDoFont + weDoSize + weDoColor + weDoFace+weDoReplaceFace, + &prefs.unread, we); + } + WEFeatureFlag (weFMonoStyled, weBitSet, we); + WEPaste (we); + WEFeatureFlag (weFMonoStyled, weBitClear, we); + }else{ + WEPaste (we); + } + break; + case kItemClear: + WEDelete (we); + break; + case kItemSelectAll: + WESetSelection (0, LONG_MAX, we); + break; + case kItemShowClipboard: + ClipShow (); + break; + case kItemFind: + XXX (); + break; + case kItemReplace: + XXX (); + break; + case kItemPreferences: + XXX (); + break; + default: Assert (0); + } +} + +static WindowPtr **winTable; /* a handle */ +static long winTableLen = 0; /* number of entries in the table */ + +static void DoWindowsChoice (short item, EventModifiers mods) +{ + switch (item){ + case 1: + Assert (winToplevel != NULL); + SelectWindow (winToplevel); + break; + case 2: + Assert (winGraphics != NULL); + ShowWindow (winGraphics); + SelectWindow (winGraphics); + break; + case 3: + Assert (0); + default: + Assert (item - 4 >= 0 && item - 4 < winTableLen); + SelectWindow ((*winTable)[item - 4]); + break; + } +} + +void DoMenuChoice (long choice, EventModifiers mods) +{ + short menu = HiWord (choice); + short item = LoWord (choice); + + switch (menu){ + case 0: break; + case kMenuApple: + DoAppleChoice (item, mods); + HiliteMenu (0); + break; + case kMenuFile: + DoFileChoice (item, mods); + HiliteMenu (0); + break; + case kMenuEdit: + DoEditChoice (item, mods); + HiliteMenu (0); + break; + case kMenuWindows: + DoWindowsChoice (item, mods); + HiliteMenu (0); + break; + default: Assert (0); + } +} + +OSErr InitialiseMenus (void) +{ + OSErr err; + Size s = 10; + + err = AllocHandle (s * sizeof (WindowPtr), (Handle *) &winTable); + if (err != noErr) return err; + + SetMenuBar (GetNewMBar (kMenuBar)); + AppendResMenu (GetMenuHandle (kMenuApple), 'DRVR'); + DrawMenuBar (); + return 0; +} + +static void EnableDisableItem (MenuHandle menu, short item, int enable) +{ + if (enable){ + EnableItem (menu, item); + }else{ + DisableItem (menu, item); + } +} + +/* Add w to the windows menu. */ +OSErr MenuWinAdd (WindowPtr w) +{ + MenuHandle m; + Str255 title; + Size s = GetHandleSize ((Handle) winTable) / sizeof (WindowPtr); + + if (s <= winTableLen){ + OSErr err; + SetHandleSize ((Handle) winTable, (s + 10) * sizeof (WindowPtr)); + err = MemError (); if (err != noErr) return err; + } + (*winTable)[winTableLen] = w; + ++ winTableLen; + + m = GetMenuHandle (kMenuWindows); + AppendMenu (m, "\px"); + GetWTitle (w, title); + SetMenuItemText (m, (winTableLen-1) + 4, title); + + return noErr; +} + +/* Remove w from the windows menu; do nothing if w is not there. */ +void MenuWinRemove (WindowPtr w) +{ + long i; + MenuHandle m; + + i = 0; + while (1){ + if (i >= winTableLen) return; + if ((*winTable)[i] == w) break; + ++ i; + } + Assert (i < winTableLen); + m = GetMenuHandle (kMenuWindows); + DeleteMenuItem (m, kItemDocuments + i); + for (++i; i < winTableLen; i++) (*winTable)[i-1] = (*winTable)[i]; + -- winTableLen; +} + +static void MenuWinUpdate (void) +{ + long i; + MenuHandle m = GetMenuHandle (kMenuWindows); + WindowPtr w = FrontWindow (); + + SetItemMark (m, kItemToplevel, w == winToplevel ? diamondMark : noMark); + SetItemMark (m, kItemGraphics, w == winGraphics ? diamondMark : noMark); + for (i = 0; i < winTableLen; i++){ + SetItemMark (m, kItemDocuments + i, + w == (*winTable)[i] ? diamondMark : noMark); + } +} + +void UpdateMenus (void) +{ + WindowPtr w; + WStatusH st; + WEHandle we; + MenuHandle m; + Str255 text; + + w = FrontWindow (); + st = WinGetStatus (w); + we = WinGetWE (w); + + WinUpdateStatus (w); + + m = GetMenuHandle (kMenuFile); + /* New is always enabled. */ + /* Open is always enabled. */ + EnableDisableItem (m, kItemClose, w != NULL && GetWindowGoAwayFlag (w)); + EnableDisableItem (m, kItemSave, st != NULL && (*st)->dirty + && (*st)->datarefnum != -1); + EnableDisableItem (m, kItemSaveAs, w != NULL && (*st)->hascontents); + EnableDisableItem (m, kItemRevert, st != NULL && (*st)->dirty + && (*st)->datarefnum != -1); + EnableDisableItem (m, kItemPageSetup, w != NULL && (*st)->hascontents); + EnableDisableItem (m, kItemPrint, w != NULL && (*st)->hascontents); + /* Quit is always enabled. */ + + m = GetMenuHandle (kMenuEdit); + DisableItem (m, kItemUndo); + GetIndString (text, kUndoStrings, 1); + SetMenuItemText (m, kItemUndo, text); + if (we != NULL){ + Boolean temp; + WEActionKind ak; + long selstart, selend; + + Assert (st != NULL); + + ak = WEGetUndoInfo (&temp, we); + if (ak != weAKNone){ + EnableItem (m, kItemUndo); + GetIndString (text, kUndoStrings, 2*ak + temp); + SetMenuItemText (m, kItemUndo, text); + } + + WEGetSelection (&selstart, &selend, we); + EnableDisableItem (m, kItemCut, (*st)->canwritesel && selstart != selend); + EnableDisableItem (m, kItemCopy, selstart != selend); + EnableDisableItem (m, kItemPaste, WECanPaste (we)); + EnableDisableItem (m, kItemClear, + (*st)->canwritesel && selstart != selend); + EnableDisableItem (m, kItemSelectAll, + (*st)->hascontents && WEGetTextLength (we) > 0); + /* Show Clipboard is always enabled. */ + EnableDisableItem (m, kItemFind, (*st)->hascontents); + EnableDisableItem (m, kItemReplace, (*st)->kind == kWinDocument); + /* PreferencesÉ is always enabled. */ + }else{ + /* Graphics window: no editing operations. */ + DisableItem (m, kItemCut); + DisableItem (m, kItemCopy); + DisableItem (m, kItemPaste); + DisableItem (m, kItemClear); + DisableItem (m, kItemSelectAll); + /* Show Clipboard is always enabled. */ + DisableItem (m, kItemFind); + DisableItem (m, kItemReplace); + /* PreferencesÉ is always enabled. */ + } + MenuWinUpdate (); + m = GetMenuHandle (kMenuWindows); + EnableDisableItem (m, kItemGraphics, winGraphics != NULL); +} diff --git a/maccaml/misc.c b/maccaml/misc.c new file mode 100644 index 000000000..8f2c09872 --- /dev/null +++ b/maccaml/misc.c @@ -0,0 +1,22 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +void LocalToGlobalRect (Rect *r) +{ + Point *p = (Point *) r; + + LocalToGlobal (&p[0]); + LocalToGlobal (&p[1]); +} diff --git a/maccaml/modalfilter.c b/maccaml/modalfilter.c new file mode 100644 index 000000000..42fd67f69 --- /dev/null +++ b/maccaml/modalfilter.c @@ -0,0 +1,81 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +/* See ocaml.r before modifying this. */ +typedef struct { + char mod; + char chr; + char item; + char filler; +} KeyEquRecord, **KeyEquHandle; + +short modalkeys; +ModalFilterUPP myModalFilterUPP; + +/* Before calling ModalDialog with myModalFilter, set the dialog + window's refcon to the resource number of the key equivalence + list for the dialog. +*/ +static pascal Boolean myModalFilter (DialogPtr d, EventRecord *evt, + DialogItemIndex *item) +{ + Boolean result = false; + char key; + int cmdflag; + KeyEquHandle equivlist; + int equivcount, i; + short itemtype; + Handle itemhandle; + Rect itemrect; + unsigned long ticks; + + switch (evt->what){ + case updateEvt: + if ((WindowPtr) evt->message != d) WinUpdate ((WindowPtr) evt->message); + break; + case activateEvt: + if ((WindowPtr) evt->message != d){ + WinActivateDeactivate (evt->modifiers & activeFlag, + (WindowPtr) evt->message); + } + break; + case keyDown: case autoKey: + key = evt->message & charCodeMask; + cmdflag = !!(evt->modifiers & cmdKey); + equivlist = (KeyEquHandle) GetResource ('Kequ', modalkeys); + if (equivlist != NULL){ + equivcount = GetHandleSize ((Handle) equivlist) / sizeof (KeyEquRecord); + for (i = 0; i < equivcount; i++){ + if ((*equivlist)[i].chr == key && (!(*equivlist)[i].mod || cmdflag)){ + result = true; + *item = (*equivlist)[i].item; + GetDialogItem (d, *item, &itemtype, &itemhandle, &itemrect); + HiliteControl ((ControlHandle) itemhandle, kControlButtonPart); + Delay (kVisualDelay, &ticks); + HiliteControl ((ControlHandle) itemhandle, 0); + } + } + } + break; + default: break; + } + return result; +} + +OSErr InitialiseModalFilter (void) +{ + myModalFilterUPP = NewModalFilterProc (myModalFilter); + return noErr; +} diff --git a/maccaml/ocaml.r b/maccaml/ocaml.r new file mode 100644 index 000000000..01dd66c4f --- /dev/null +++ b/maccaml/ocaml.r @@ -0,0 +1,1152 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "constants.h" + +resource 'vers' (1) { +#define d development +#define a alpha +#define b beta + OCAMLVNUM, MACVNUM, STAGE, DEVVNUM, + 0, + VERSIONSTR, + "Objective Caml version " VERSIONSTR "\n" + "Copyright 1991-1998 INRIA" +#undef d +#undef a +#undef b +}; + +resource 'SIZE' (-1) { + reserved, + acceptSuspendResumeEvents, + reserved, + canBackground, + doesActivateOnFGSwitch, + backgroundAndForeground, + dontGetFrontClicks, + ignoreChildDiedEvents, + is32BitCompatible, + isHighLevelEventAware, + localAndRemoteHLEvents, + isStationeryAware, + dontuseTextEditServices, + reserved, + reserved, + reserved, + 4000 * 1024, + 1500 * 1024 +}; + +data 'Line' (kCommandLineTemplate) { + "%a\000" +}; + +data 'Line' (kEnvironmentTemplate) { + "CAMLLIB=%dstdlib:\000" + "TempFolder=%t\000" +}; + +type 'Kequ' { + wide array KequArray { + byte any = 0 command = 1; + byte char; + byte item; + fill byte; + }; +}; + +resource 'Kequ' (kKeysOK) { + { + any, charReturn, 1, + any, charEnter, 1, + any, 'o', 1, + any, 'O', 1, + } +}; + +resource 'Kequ' (kKeysSaveDontCancel) { + { + any, charReturn, 1, + any, charEnter, 1, + any, 'y', 1, + any, 'Y', 1, + any, 's', 1, + any, 'S', 1, + + any, charEscape, 2, + command, '.', 2, + any, 'c', 2, + any, 'C', 2, + + any, 'n', 3, + any, 'N', 3, + any, 'd', 3, + any, 'D', 3, + } +}; + +resource 'ALRT' (kAlertBug) { + {60, 61, 260, 451}, kAlertBug, + { + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + }, + alertPositionParentWindowScreen +}; + +resource 'DITL' (kAlertBug) { + { + {160, 310, 180, 368}, Button {enabled, "Quit"}, + + {10, 70, 80, 368}, + StaticText {disabled, + "You have discovered a bug in Objective Caml. Please" + " report the following information to <caml-light@inria.fr>." + }, + + {80, 20, 145, 368}, + StaticText {disabled, "file: ^1\nline: ^2\nexpr: ^0"}, + } +}; + +resource 'ALRT' (kAlertNotYet) { + {60, 81, 160, 431}, kAlertNotYet, + { + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + }, + alertPositionParentWindowScreen +}; + +resource 'DITL' (kAlertNotYet) { + { + {60, 270, 80, 328}, Button {enabled, "OK"}, + + {10, 70, 45, 328}, + StaticText {disabled, "This feature is not yet implemented." }, + } +}; + +resource 'ALRT' (kAlertNeedSys7) { + {60, 81, 200, 431}, kAlertNeedSys7, + { + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + }, + alertPositionMainScreen +}; + +resource 'DITL' (kAlertNeedSys7) { + { + {100, 270, 120, 328}, + Button {enabled, "Quit"}, + + {10, 70, 85, 328}, + StaticText { + disabled, + "Objective Caml cannot run on MacOS versions prior to System 7." + }, + + {10, 20, 42, 52}, Icon {disabled, kJoeCamlIcon}, + } +}; + +resource 'ALRT' (kAlertNeed32BitQD) { + {60, 81, 200, 431}, kAlertNeed32BitQD, + { + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + }, + alertPositionMainScreen +}; + +resource 'DITL' (kAlertNeed32BitQD) { + { + {100, 270, 120, 328}, + Button {enabled, "Quit"}, + + {10, 70, 85, 328}, + StaticText { + disabled, + "Objective Caml needs a Macintosh with 32-bit color QuickDraw." + }, + + {10, 20, 42, 52}, Icon {disabled, kJoeCamlIcon}, + } +}; + +resource 'ALRT' (kAlertNonZeroExit) { + {60, 81, 200, 431}, kAlertNonZeroExit, + { + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + }, + alertPositionParentWindowScreen +}; + +resource 'DITL' (kAlertNonZeroExit) { + { + {100, 270, 120, 328}, Button {enabled, "OK"}, + + {10, 70, 85, 328}, + StaticText { + disabled, + "The O'Caml toplevel loop exited with error code ^0." + }, + } +}; + +resource 'ALRT' (kAlertErrorMsg) { + {60, 81, 200, 431}, kAlertErrorMsg, + { + OK, visible, sound1, + OK, visible, sound1, + OK, visible, sound1, + OK, visible, sound1, + }, + alertPositionParentWindowScreen +}; + +resource 'DITL' (kAlertErrorMsg) { + { + {100, 270, 120, 328}, Button {enabled, "OK"}, + {10, 70, 85, 328}, StaticText { disabled, "^0^1^2^3" }, + } +}; + +resource 'ALRT' (kAlertErrorNum) { + {60, 81, 200, 431}, kAlertErrorNum, + { + OK, visible, sound1, + OK, visible, sound1, + OK, visible, sound1, + OK, visible, sound1, + }, + alertPositionParentWindowScreen +}; + +resource 'DITL' (kAlertErrorNum) { + { + {100, 270, 120, 328}, Button {enabled, "OK"}, + + {10, 70, 85, 328}, + StaticText { disabled, "An error occurred.\n\nerror code = ^3" }, + } +}; + +resource 'ALRT' (kAlertGeneric) { + {60, 81, 200, 431}, kAlertGeneric, + { + OK, visible, sound1, + OK, visible, sound1, + OK, visible, sound1, + OK, visible, sound1, + }, + alertPositionParentWindowScreen +}; + +resource 'DITL' (kAlertGeneric) { + { + {100, 270, 120, 328}, Button {enabled, "OK"}, + + {10, 20, 85, 378}, + StaticText { disabled, "^0^1^2^3" }, + } +}; + +resource 'ALRT' (kAlertSaveAsk) { + {60, 81, 200, 431}, kAlertSaveAsk, + { + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + OK, visible, silent, + }, + alertPositionParentWindowScreen +}; + +resource 'DITL' (kAlertSaveAsk) { + { + {100, 270, 120, 328}, Button {enabled, "Save"}, + {100, 202, 120, 260}, Button {enabled, "Cancel"}, + {100, 22, 120, 110}, Button {enabled, "Don't Save"}, + {10, 70, 85, 328}, StaticText { disabled, "Save \"^0\" before ^1 ?" }, + {10, 20, 42, 52}, Icon {disabled, kJoeCamlIcon}, + } +}; + +resource 'DLOG' (kDialogAbout) { + {70, 60, 260, 452}, + noGrowDocProc, + visible, + goAway, + 0, + kDialogAbout, + "About Objective Caml", + alertPositionMainScreen +}; + +resource 'DITL' (kDialogAbout) { + { + {10, 20, 42, 52}, Icon {disabled, kJoeCamlIcon}, + {10, 72, 180, 382}, UserItem { disabled }, + } +}; + +data 'TEXT' (kAboutText, purgeable) { + "Objective Caml version " VERSIONSTR "\n" + "Copyright 1991-1998 INRIA\n" + "\n" + "Xavier Leroy, Jer™me Vouillon, Damien Doligez, et al.\n" + "\n" + "\n" + "O'Caml's interface to MacOS is compiled with MPW" + " and uses the WASTE text engine.\n" + "\n" + "WASTE text engine © 1993-1996 Marco Piovanelli\n" + "\n" + "MPW libraries © 1995-1998 by Apple Computer, Inc., all rights reserved" +}; + +resource 'MBAR' (kMenuBar) { + {kMenuApple, kMenuFile, kMenuEdit, kMenuWindows, } +}; + +resource 'MENU' (kMenuApple) { + kMenuApple, + textMenuProc, + 0x7FFFFFFD, + enabled, + apple, + { + "About Objective CamlÉ", noIcon, noKey, noMark, plain, + "-", noIcon, noKey, noMark, plain, + } +}; + +resource 'MENU' (kMenuFile) { + kMenuFile, + textMenuProc, + 0x7FFFFB7B, + enabled, + "File", + { + "New", noIcon, "N", noMark, plain, + "OpenÉ", noIcon, "O", noMark, plain, + "-", noIcon, noKey, noMark, plain, + "Close", noIcon, "W", noMark, plain, + "Save", noIcon, "S", noMark, plain, + "Save asÉ", noIcon, noKey, noMark, plain, + "Revert to Saved", noIcon, noKey, noMark, plain, + "-", noIcon, noKey, noMark, plain, + "Page SetupÉ", noIcon, nokey, noMark, plain, + "PrintÉ", noIcon, "P", noMark, plain, + "-", noIcon, noKey, noMark, plain, + "Quit", noIcon, "Q", noMark, plain, + } +}; + +resource 'MENU' (kMenuEdit) { + kMenuEdit, + textMenuProc, + 0x7FFFFFBD, + enabled, + "Edit", + { + "Undo", noIcon, "Z", noMark, plain, + "-", noIcon, noKey, noMark, plain, + "Cut", noIcon, "X", noMark, plain, + "Copy", noIcon, "C", noMark, plain, + "Paste", noIcon, "V", noMark, plain, + "Clear", noIcon, noKey, noMark, plain, + "Select All", noIcon, "A", noMark, plain, + "Show Clipboard", noIcon, noKey, noMark, plain, + "-", noIcon, noKey, noMark, plain, + "FindÉ", noIcon, "F", noMark, plain, + "ReplaceÉ", noIcon, "R", noMark, plain, + "-", noIcon, noKey, noMark, plain, + "PreferencesÉ", noIcon, noKey, noMark, plain, + } +}; + +resource 'MENU' (kMenuWindows) { + kMenuWindows, + textMenuProc, + 0x7FFFFFF9, + enabled, + "Windows", + { + "Toplevel", noIcon, "T", noMark, plain, + "Graphics", noIcon, "G", noMark, plain, + "-", noIcon, noKey, noMark, plain, + } +}; + +resource 'STR#' (kUndoStrings) { + { + "Cannot undo", + "Undo", "Redo", + "Undo Typing", "Redo Typing", + "Undo Cut", "Redo Cut", + "Undo Paste", "Redo Paste", + "Undo Clear", "Redo Clear", + "Undo Drag & Drop", "Redo Drag & Drop", + /* Style change is not supported. */ + } +}; + +resource 'STR#' (kMiscStrings, purgeable) { + { + "Objective Caml Preferences", + "Untitled", + "closing", + "quitting", + "Unable to open \"", + "\". ", + "Save file as:", + "", + "Unable to write to \"", + } +}; + +resource 'STR#' (kErrorStrings, purgeable) { + { + "There is not enough memory.", + "The disk is full.", + "The directory is full.", + "Too many files are already open.", + "The file does not exist.", + "The disk is write-protected.", + "The file is locked.", + "The disk is locked.", + "The file is in use.", + "The file is already open (by Objective Caml or another application).", + "The disk was ejected.", + "The file is locked or you do not have the permission to open it.", + "You do not have the permission to write to this file.", + "The folder does not exist.", + "The connexion to the file server was closed or broken.", + "A hardware error occurred during input or output.", + } +}; + +resource 'STR ' (kPrefsDescriptionStr, purgeable) { + "This document describes user preferences for Objective Caml. " + "You cannot open or print this document. To be " + "effective, this document must be stored in the Preferences " + "folder of the System Folder." +}; + +resource 'WIND' (kToplevelWinTemplate) { + {40, 4, 342, 512}, + zoomDocProc, + invisible, + noGoAway, + 0, + "O'Caml Toplevel", + noAutoCenter +}; + +resource 'WIND' (kGraphicsWinTemplate) { + {40, 4, 342, 512}, + zoomDocProc, + invisible, + goAway, + 0, + "O'Caml Graphics", + noAutoCenter +}; + +resource 'WIND' (kDocumentWinTemplate) { + {45, 10, 342, 512}, + zoomDocProc, + visible, + goAway, + 0, + "Untitled", + staggerMainScreen +}; + +resource 'CNTL' (kScrollBarTemplate) { + {0, 0, 16, 16}, + 0, + invisible, + 0, 0, + scrollBarProc, + 0, + "" +}; + +resource 'acur' (0) { + {1000, 1001, 1002, 1003, } +}; + +resource 'CURS' (1000) { + $"07C0 1F30 3F08 7F04 7F04 FF02 FF02 FFFE" + $"81FE 81FE 41FC 41FC 21F8 19F0 07C0", + $"07C0 1FF0 3FF8 7FFC 7FFC FFFE FFFE FFFE" + $"FFFE FFFE 7FFC 7FFC 3FF8 1FF0 07C0", + {7, 7} +}; + +resource 'CURS' (1001) { + $"07C0 1FF0 3FF8 5FF4 4FE4 87C2 8382 8102" + $"8382 87C2 4FE4 5FF4 3FF8 1FF0 07C0", + $"07C0 1FF0 3FF8 7FFC 7FFC FFFE FFFE FFFE" + $"FFFE FFFE 7FFC 7FFC 3FF8 1FF0 07C0", + {7, 7} +}; + +resource 'CURS' (1002) { + $"07C0 19F0 21F8 41FC 41FC 81FE 81FE FFFE" + $"FF02 FF02 7F04 7F04 3F08 1F30 07C0", + $"07C0 1FF0 3FF8 7FFC 7FFC FFFE FFFE FFFE" + $"FFFE FFFE 7FFC 7FFC 3FF8 1FF0 07C0", + {7, 7} +}; + +resource 'CURS' (1003) { + $"07C0 1830 2008 701C 783C FC7E FEFE FFFE" + $"FEFE FC7E 783C 701C 2008 1830 07C0", + $"07C0 1FF0 3FF8 7FFC 7FFC FFFE FFFE FFFE" + $"FFFE FFFE 7FFC 7FFC 3FF8 1FF0 07C0", + {7, 7} +}; + +resource 'snd ' (1002){ + FormatOne{ + { sampledSynth, 0x80 }, + }, + { + hasData, soundCmd {0x2C}, + noData, ampCmd {127}, + noData, freqDurationCmd {/* duration */ 0x4321, 60}, + noData, quietCmd {}, + }, + { + 4, + /* sampling rate */ Rate22K, + 0, 4, + 0, + 60, + $"FF01FF01" + } +}; + +resource 'snd ' (1004){ + FormatOne{ + { sampledSynth, 0x80 }, + }, + { + hasData, soundCmd {0x2C}, + noData, ampCmd {127}, + noData, freqDurationCmd {0x4321, 60}, + noData, quietCmd {}, + }, + { + 4, + Rate22K, + 0, 4, + 0, + 60, + $"FF800180" + } +}; + +resource 'snd ' (1008){ + FormatOne{ + { sampledSynth, 0x80 }, + }, + { + hasData, soundCmd {0x2C}, + noData, ampCmd {127}, + noData, freqDurationCmd {0x4321, 60}, + noData, quietCmd {}, + }, + { + 8, + Rate22K, + 0, 8, + 0, + 60, + $"FFDA8026012680DA" + } +}; + +resource 'snd ' (1032){ + FormatOne{ + { sampledSynth, 0x80 }, + }, + { + hasData, soundCmd {0x2C}, + noData, ampCmd {127}, + noData, freqDurationCmd {0x4321, 60}, + noData, quietCmd {}, + }, + { + 32, + Rate22K, + 0, 32, + 0, + 60, + $"FFFDF5EADAC7B19980674F3926160B0301030B1626394F678099B1C7DAEAF5FD" + } +}; + + +resource 'snd ' (1128){ + FormatOne{ + { sampledSynth, 0x80 }, + }, + { + hasData, soundCmd {0x2C}, + noData, ampCmd {127}, + noData, freqDurationCmd {0x4321, 60}, + noData, quietCmd {}, + }, + { + 128, + Rate22K, + 0, 128, + 0, + 60, + $"FFFFFEFEFDFBFAF8F5F3F0EDEAE6E2DEDAD5D1CCC7C1BCB6B1ABA59F99938C86" + $"807A746D67615B554F4A443F39342F2B26221E1A1613100D0B08060503020201" + $"01010202030506080B0D1013161A1E22262B2F34393F444A4F555B61676D747A" + $"80868C93999FA5ABB1B6BCC1C7CCD1D5DADEE2E6EAEDF0F3F5F8FAFBFDFEFEFF" + } +}; + +resource 'snd ' (1512, "foo"){ + FormatOne{ + { sampledSynth, 0x80 }, + }, + { + hasData, soundCmd {0x2C}, + noData, ampCmd {127}, + noData, freqDurationCmd {0x4321, 60}, + noData, quietCmd {}, + }, + { + 512, + Rate22K, + 0, 512, + 0, + 60, + $"FFFFFFFFFFFFFFFFFEFEFEFEFEFDFDFDFDFCFCFCFBFBFAFAFAF9F9F8F8F7F6F6" + $"F5F5F4F3F3F2F1F1F0EFEFEEEDECEBEAEAE9E8E7E6E5E4E3E2E1E0DFDEDDDCDB" + $"DAD9D8D6D5D4D3D2D1CFCECDCCCAC9C8C7C5C4C3C1C0BFBDBCBAB9B8B6B5B3B2" + $"B1AFAEACABA9A8A6A5A3A2A09F9D9C9A999796949391908E8C8B898886858382" + $"807E7D7B7A7877757472706F6D6C6A696766646361605E5D5B5A585755545251" + $"4F4E4D4B4A484746444341403F3D3C3B39383736343332312F2E2D2C2B2A2827" + $"262524232221201F1E1D1C1B1A1918171616151413121111100F0F0E0D0D0C0B" + $"0B0A0A0908080707060606050504040403030303020202020201010101010101" + $"0101010101010101020202020203030303040404050506060607070808090A0A" + $"0B0B0C0D0D0E0F0F1011111213141516161718191A1B1C1D1E1F202122232425" + $"2627282A2B2C2D2E2F31323334363738393B3C3D3F404143444647484A4B4D4E" + $"4F5152545557585A5B5D5E606163646667696A6C6D6F7072747577787A7B7D7E" + $"808283858688898B8C8E909193949697999A9C9D9FA0A2A3A5A6A8A9ABACAEAF" + $"B1B2B3B5B6B8B9BABCBDBFC0C1C3C4C5C7C8C9CACCCDCECFD1D2D3D4D5D6D8D9" + $"DADBDCDDDEDFE0E1E2E3E4E5E6E7E8E9EAEAEBECEDEEEFEFF0F1F1F2F3F3F4F5" + $"F5F6F6F7F8F8F9F9FAFAFAFBFBFCFCFCFDFDFDFDFEFEFEFEFEFFFFFFFFFFFFFF" + } +}; + + +/***************************************************************** + derez -m 60 'alcools:caml light:caml-icons.rsrc' "{rincludes}types.r" ¶ + "{rincludes}finder.r" "{rincludes}icons.r" >>ocaml.r +*/ + +resource 'icl4' (1000) { + $"0000 0000 000F FFFF F000 0000 0000 0000 0000 0000 00FF FFFF" + $"FFF0 0000 0000 0000 0000 0000 FFFF FFFF FFFF 0000 0000 0000" + $"FFFF FF0F FFFF BBBB BBBF F000 00FF FFF0 FAAA AAFF FFBB BBBB" + $"BBBB BFFF FFFF FFF0 FAAA AAAF FFFF FFFF FFFF FFFF FFFF FFF0" + $"FAAA AAAA FFFD DDFF FFFF FFFF FFFF FF00 FFAA AAAA AFFF CCFF" + $"FFFF FFFF FFFF FF00 0FFA AAAA AAFF FCFF FFFF FBBF FFFF F000" + $"00FF FAAA AAAF FFFF FFFF BBBB FFFF 0000 0000 FFAA AAAA FFFF" + $"FFFF BBBB BBFF 0000 0000 0FFA AAAA AFFF FFFA ABBB BBBF F000" + $"0000 0FFA AAAA ABBB BBFF AABB BBBB FF00 0000 FFFA AAAA BBBB" + $"BBBF FAAB BBBB BFF0 0000 FFFA AAAB BBBB BBBB FFAA BBBB BBFF" + $"0000 FFFA AAAB BBBB FFBB BFFA ABBB BBFF 0000 FFFA AAAB BBBB" + $"FFBB BBFF AABA BBFF 0000 FFFA AAAB BBBB FFBB BBBF FAAA AAFF" + $"0000 FFFA AAAB BBBB FFBB BBBB FFAA AAFF 0000 FFFA AAAA BBBB" + $"FFBB BBBB BFFA AFFF 0000 FFFF AAAA ABBB FFFB BBBB BBFF AFBF" + $"0000 0FFF AAAA AABB FFFB BBBB BBBF FFBF 0000 00FF AAAA AAA1" + $"81FB BBBB BBBF FBBF 0000 000F AAAA A81A AFFF BBBB BBBF FBBF" + $"0000 000F AAA1 8AAA AFFF FBBB BBBF FBBF 0000 00FF A81A 1AAA" + $"AAAF FFBB BBBF FBBF 0000 00FA 11AA 8AAA AAAA FFFB BBFF FBF0" + $"0000 0FF8 A8AA AAAA AAAA AFFF BFFF FBF0 0000 0F8A A8AA AAAA" + $"AAAA AAFF FFFF FF00 0000 FFAA AAAA AAAA AAAA AFFF FFF0 0000" + $"0000 FAAA AAAA AAAA AAAA FF00 0000 0000 0000 FFFF FFFF FFFF" + $"FFFF F0" +}; + +resource 'icl4' (1001) { + $"0FFF FFFF FFFF FFFF FFFF 0000 0000 0000 0F00 0000 0000 0000" + $"000F F000 0000 0000 0F00 0000 0000 0000 000F CF00 0000 0000" + $"0F00 0000 0FFF FF00 000F 0CF0 0000 0000 0F00 FFFF FFBB BFFF" + $"FFFF 00CF 0000 0000 0F00 FAAF FFFF FFFF FFFF 0CCC F000 0000" + $"0F00 FAAA FFFF FFFF FFFF FFFF FF00 0000 0F00 0FFA AFFF FFBB" + $"FF00 DDDD DF00 0000 0F00 00FF AAFF FFAB BF00 CCCC CF00 0000" + $"0F00 00FF AAAB BFAA BBF0 0000 CF00 0000 0F00 00FF AABB BBFA" + $"ABBF 0000 CF00 0000 0F00 00FF AABB FBBF AAAF 0000 CF00 0000" + $"0F00 00FF AABB FBBB FFFF 0000 CF00 0000 0F00 00FF AAAB FBBB" + $"BFBF 0000 CF00 0000 0F00 000F AA81 FBBB BFBF 0000 CF00 0000" + $"0F00 000F 818A AFBB BFBF 0000 CF00 0000 0F00 00FF 8A8A AAFB" + $"BFF0 0000 CF00 0000 0F00 00F8 AAAA AAFF FF00 0000 CF00 0000" + $"0F00 00FF FFFF FFF0 0000 0000 CF00 0000 0F00 0000 0000 0000" + $"0000 0000 CF00 0000 0F00 0000 0000 0000 0000 0000 CF00 0000" + $"0F00 0000 0000 0000 0000 0000 CF00 0000 0F00 0000 0000 0000" + $"0000 0000 CF00 0000 0F00 FF00 FF00 0000 0000 0000 CF00 0000" + $"0F00 FF00 FF00 0000 0000 0000 CF00 0000 0F00 0000 0000 0000" + $"0000 0000 CF00 0000 0F00 FF00 FF00 0000 0000 0000 CFE0 0000" + $"0F00 FF00 FF00 0000 0000 0000 CFEE E000 0F00 0F00 0F00 0000" + $"0000 0000 CFEE EEE0 0F00 F000 F000 0000 0000 0000 CFEE EEE0" + $"0F00 0000 0000 0000 0000 0000 CFEE E000 0FFF FFFF FFFF FFFF" + $"FFFF FFFF FFE0" +}; + +resource 'icl4' (1002) { + $"FFFF FFFF FFFF FFFF FFFF FFFF F000 0000 F000 0000 0000 0000" + $"0000 0000 F000 0000 F00F F00F F000 0000 0000 0000 FFF0 0000" + $"F00F F00F F000 0000 0000 0000 FDF0 0000 F000 0000 0000 0000" + $"0000 0000 FDF0 0000 F00F F00F F000 0000 0000 0000 FDF0 0000" + $"F00F F00F F000 0000 0000 0000 FDF0 0000 F000 F000 F000 0000" + $"0000 0000 FDF0 0000 F00F 000F 0000 0000 0000 0000 FDF0 0000" + $"F000 0000 0000 0000 0000 0000 FDF0 0000 F000 0000 0000 0000" + $"0000 0000 FDF0 0000 F000 0000 0000 0000 0000 0000 FDF0 0000" + $"F000 0000 FFFF F000 0000 0000 FDF0 0000 F00F FFFF FBBB FFFF" + $"FFF0 0000 FDF0 0000 F00F AAFF FFFF FFFF FFF0 0000 FDF0 0000" + $"F00F AAAF FFFF FFFF FF00 0000 FDF0 0000 F000 FFAA FFFF FBBF" + $"F000 0000 FDF0 0000 F000 0FFA AFFF FABB F000 0000 FDF0 0000" + $"F000 0FFA AABB FAAB BF00 0000 FDF0 0000 F000 0FFA ABBB BFAA" + $"BBF0 0000 FDF0 0000 F000 0FFA ABBF BBFA AAF0 0000 FDF0 0000" + $"F000 0FFA ABBF BBBF FFF0 0000 FDF0 0000 F000 0FFA AABF BBBB" + $"FBF0 0000 FDF0 0000 F000 00FA A81F BBBB FBFF FFFF FDF0 0000" + $"F000 00F8 18AA FBBB FBFC CCCF DCF0 0000 F000 0FF8 A8AA AFBB" + $"FFFC CCFD CCF0 0000 F000 0F8A AAAA AFFF F0FC CFDC CCFE 0000" + $"F000 0FFF FFFF FF00 00FC FDCC CCFE EE00 F000 0000 0000 0000" + $"00FF DCCC CCFE EEEE FFFF FFFF FFFF FFFF FFFD CCCC CCFE EEEE" + $"00FD DDDD DDDD DDDD DDDC CCCC CCFE EE00 00FF FFFF FFFF FFFF" + $"FFFF FFFF FFFE" +}; + +resource 'icl8' (1000) { + $"0000 0000 0000 0000 0000 00FF FFFF FFFF FF00 0000 0000 0000" + $"0000 0000 0000 0000 0000 0000 0000 0000 0000 FFFF FFFF FFFF" + $"FFFF FF00 0000 0000 0000 0000 0000 0000 0000 0000 0000 0000" + $"FFFF FFFF FFFF FFFF FFFF FFFF 0000 0000 0000 0000 0000 0000" + $"FFFF FFFF FFFF 00FF FFFF FFFF 0808 0808 0808 08FF FF00 0000" + $"0000 FFFF FFFF FF00 FF33 3333 3333 FFFF FFFF 0808 0808 0808" + $"0808 0808 08FF FFFF FFFF FFFF FFFF FF00 FF33 3333 3333 33FF" + $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FF00" + $"FF33 3333 3333 3333 FFFF FFF9 F9F9 FFFF FFFF FFFF FFFF FFFF" + $"FFFF FFFF FFFF 0000 FFFF 3333 3333 3333 33FF FFFF F6F6 FFFF" + $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF 0000 00FF FF33 3333 3333" + $"3333 FFFF FFF6 FFFF FFFF FFFF FF08 08FF FFFF FFFF FF00 0000" + $"0000 FFFF FF33 3333 3333 33FF FFFF FFFF FFFF FFFF 0808 0808" + $"FFFF FFFF 0000 0000 0000 0000 FFFF 3333 3333 3333 FFFF FFFF" + $"FFFF FFFF 0808 0808 0808 FFFF 0000 0000 0000 0000 00FF FF33" + $"3333 3333 33FF FFFF FFFF FF33 3308 0808 0808 08FF FF00 0000" + $"0000 0000 00FF FF33 3333 3333 3308 0808 0808 FFFF 3333 0808" + $"0808 0808 FFFF 0000 0000 0000 FFFF FF33 3333 3333 0808 0808" + $"0808 08FF FF33 3308 0808 0808 08FF FF00 0000 0000 FFFF FF33" + $"3333 3308 0808 0808 0808 0808 FFFF 3333 0808 0808 0808 FFFF" + $"0000 0000 FFFF FF33 3333 3308 0808 0808 FFFF 0808 08FF FF33" + $"3308 0808 0808 FFFF 0000 0000 FFFF FF33 3333 3308 0808 0808" + $"FFFF 0808 0808 FFFF 3333 0833 0808 FFFF 0000 0000 FFFF FF33" + $"3333 3308 0808 0808 FFFF 0808 0808 08FF FF33 3333 3333 FFFF" + $"0000 0000 FFFF FF33 3333 3308 0808 0808 FFFF 0808 0808 0808" + $"FFFF 3333 3333 FFFF 0000 0000 FFFF FF33 3333 3333 0808 0808" + $"FFFF 0808 0808 0808 08FF FF33 33FF FFFF 0000 0000 FFFF FFFF" + $"3333 3333 3308 0808 FFFF FF08 0808 0808 0808 FFFF 33FF 08FF" + $"0000 0000 00FF FFFF 3333 3333 3333 0808 FFFF FF08 0808 0808" + $"0808 08FF FFFF 08FF 0000 0000 0000 FFFF 3333 3333 3333 3305" + $"E305 FF08 0808 0808 0808 08FF FF08 08FF 0000 0000 0000 00FF" + $"3333 3333 33E3 0533 33FF FFFF 0808 0808 0808 08FF FF08 08FF" + $"0000 0000 0000 00FF 3333 3305 E333 3333 33FF FFFF FF08 0808" + $"0808 08FF FF08 08FF 0000 0000 0000 FFFF 33E3 0533 0533 3333" + $"3333 33FF FFFF 0808 0808 08FF FF08 08FF 0000 0000 0000 FF33" + $"0505 3333 E333 3333 3333 3333 FFFF FF08 0808 FFFF FF08 FF00" + $"0000 0000 00FF FFE3 33E3 3333 3333 3333 3333 3333 33FF FFFF" + $"08FF FFFF FF08 FF00 0000 0000 00FF E333 33E3 3333 3333 3333" + $"3333 3333 3333 FFFF FFFF FFFF FFFF 0000 0000 0000 FFFF 3333" + $"3333 3333 3333 3333 3333 3333 33FF FFFF FFFF FF00 0000 0000" + $"0000 0000 FF33 3333 3333 3333 3333 3333 3333 3333 FFFF 0000" + $"0000 0000 0000 0000 0000 0000 FFFF FFFF FFFF FFFF FFFF FFFF" + $"FFFF FFFF FF" +}; + +resource 'icl8' (1001) { + $"00FF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF 0000 0000" + $"0000 0000 0000 0000 00FF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F5F5 F5FF FF00 0000 0000 0000 0000 0000 00FF F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 F5F5 F5FF F8FF 0000 0000 0000 0000 0000" + $"00FF F5F5 F5F5 F5F5 F5FF FFFF FFFF F5F5 F5F5 F5FF 00F8 FF00" + $"0000 0000 0000 0000 00FF F5F5 FFFF FFFF FFFF 0808 08FF FFFF" + $"FFFF FFFF 0000 F8FF 0000 0000 0000 0000 00FF F5F5 FF33 33FF" + $"FFFF FFFF FFFF FFFF FFFF FFFF F5F6 F6F8 FF00 0000 0000 0000" + $"00FF F5F5 FF33 3333 FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF" + $"FFFF 0000 0000 0000 00FF F5F5 F5FF FF33 33FF FFFF FFFF 0808" + $"FFFF F5F5 F9F9 F9F9 F9FF 0000 0000 0000 00FF F5F5 F5F5 FFFF" + $"3333 FFFF FFFF 3308 08FF F5F5 F7F7 F7F7 F7FF 0000 0000 0000" + $"00FF F5F5 F5F5 FFFF 3333 3308 08FF 3333 0808 FFF5 F5F5 F5F5" + $"F7FF 0000 0000 0000 00FF F5F5 F5F5 FFFF 3333 0808 0808 FF33" + $"3308 08FF F5F5 F5F5 F7FF 0000 0000 0000 00FF F5F5 F5F5 FFFF" + $"3333 0808 FF08 08FF 3333 33FF F5F5 F5F5 F7FF 0000 0000 0000" + $"00FF F5F5 F5F5 FFFF 3333 0808 FF08 0808 FFFF FFFF F5F5 F5F5" + $"F7FF 0000 0000 0000 00FF F5F5 F5F5 FFFF 3333 3308 FF08 0808" + $"08FF 08FF F5F5 F5F5 F7FF 0000 0000 0000 00FF F5F5 F5F5 F5FF" + $"3333 E305 FF08 0808 08FF 08FF F5F5 F5F5 F7FF 0000 0000 0000" + $"00FF F5F5 F5F5 F5FF E305 E333 33FF 0808 08FF 08FF F5F5 F5F5" + $"F7FF 0000 0000 0000 00FF F5F5 F5F5 FFFF E333 E333 3333 FF08" + $"08FF FFF5 F5F5 F5F5 F7FF 0000 0000 0000 00FF F5F5 F5F5 FFE3" + $"3333 3333 3333 FFFF FFFF F5F5 F5F5 F5F5 F7FF 0000 0000 0000" + $"00FF F5F5 F5F5 FFFF FFFF FFFF FFFF FFF5 F5F5 F5F5 F5F5 F5F5" + $"F7FF 0000 0000 0000 00FF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 F7FF 0000 0000 0000 00FF F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F7FF 0000 0000 0000" + $"00FF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F7FF 0000 0000 0000 00FF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 F7FF 0000 0000 0000 00FF F5F5 FFFF F5F5" + $"FFFF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F7FF 0000 0000 0000" + $"00FF F5F5 FFFF F5F5 FFFF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F7FF 0000 0000 0000 00FF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 F7FF 0000 0000 0000 00FF F5F5 FFFF F5F5" + $"FFFF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F7FF FC00 0000 0000" + $"00FF F5F5 FFFF F5F5 FFFF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F7FF FCFC FC00 0000 00FF F5F5 F5FF F5F5 F5FF F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 F7FF FCFC FCFC FC00 00FF F5F5 FFF5 F5F5" + $"FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F7FF FCFC FCFC FC00" + $"00FF F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F7FF FCFC FC00 0000 00FF FFFF FFFF FFFF FFFF FFFF FFFF FFFF" + $"FFFF FFFF FFFF FFFF FFFF FC" +}; + +resource 'icl8' (1002) { + $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF" + $"FF00 0000 0000 0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 FF00 0000 0000 0000 FFF5 F5FF FFF5 F5FF" + $"FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 FFFF FF00 0000 0000" + $"FFF5 F5FF FFF5 F5FF FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"FFF9 FF00 0000 0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 FFF9 FF00 0000 0000 FFF5 F5FF FFF5 F5FF" + $"FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 FFF9 FF00 0000 0000" + $"FFF5 F5FF FFF5 F5FF FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"FFF9 FF00 0000 0000 FFF5 F5F5 FFF5 F5F5 FFF5 F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 FFF9 FF00 0000 0000 FFF5 F5FF F5F5 F5FF" + $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 FFF9 FF00 0000 0000" + $"FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"FFF9 FF00 0000 0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 FFF9 FF00 0000 0000 FFF5 F5F5 F5F5 F5F5" + $"F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 FFF9 FF00 0000 0000" + $"FFF5 F5F5 F5F5 F5F5 FFFF FFFF FFF5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"FFF9 FF00 0000 0000 FFF5 F5FF FFFF FFFF FF08 0808 FFFF FFFF" + $"FFFF FFF5 F5F5 F5F5 FFF9 FF00 0000 0000 FFF5 F5FF 3333 FFFF" + $"FFFF FFFF FFFF FFFF FFFF FFF5 F5F5 F5F5 FFF9 FF00 0000 0000" + $"FFF5 F5FF 3333 33FF FFFF FFFF FFFF FFFF FFFF F5F5 F5F5 F5F5" + $"FFF9 FF00 0000 0000 FFF5 F5F5 FFFF 3333 FFFF FFFF FF08 08FF" + $"FFF5 F5F5 F5F5 F5F5 FFF9 FF00 0000 0000 FFF5 F5F5 F5FF FF33" + $"33FF FFFF FF33 0808 FFF5 F5F5 F5F5 F5F5 FFF9 FF00 0000 0000" + $"FFF5 F5F5 F5FF FF33 3333 0808 FF33 3308 08FF F5F5 F5F5 F5F5" + $"FFF9 FF00 0000 0000 FFF5 F5F5 F5FF FF33 3308 0808 08FF 3333" + $"0808 FFF5 F5F5 F5F5 FFF9 FF00 0000 0000 FFF5 F5F5 F5FF FF33" + $"3308 08FF 0808 FF33 3333 FFF5 F5F5 F5F5 FFF9 FF00 0000 0000" + $"FFF5 F5F5 F5FF FF33 3308 08FF 0808 08FF FFFF FFF5 F5F5 F5F5" + $"FFF9 FF00 0000 0000 FFF5 F5F5 F5FF FF33 3333 08FF 0808 0808" + $"FF08 FFF5 F5F5 F5F5 FFF9 FF00 0000 0000 FFF5 F5F5 F5F5 FF33" + $"33E3 05FF 0808 0808 FF08 FFFF FFFF FFFF FFF9 FF00 0000 0000" + $"FFF5 F5F5 F5F5 FFE3 05E3 3333 FF08 0808 FF08 FF2B 2B2B F7FF" + $"F9F7 FF00 0000 0000 FFF5 F5F5 F5FF FFE3 33E3 3333 33FF 0808" + $"FFFF FF2B 2BF7 FFF9 F72B FF00 0000 0000 FFF5 F5F5 F5FF E333" + $"3333 3333 33FF FFFF FFF5 FF2B F7FF F9F7 2BF6 FFFC 0000 0000" + $"FFF5 F5F5 F5FF FFFF FFFF FFFF FFFF F5F5 F5F5 FFF7 FFF9 F72B" + $"F6F6 FFFC FCFC 0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5 F5F5" + $"F5F5 FFFF F9F7 2BF6 F6F6 FFFC FCFC FCFC FFFF FFFF FFFF FFFF" + $"FFFF FFFF FFFF FFFF FFFF FFF9 F72B F6F6 F6F6 FFFC FCFC FCFC" + $"0000 FFF9 F9F9 F9F9 F9F9 F9F9 F9F9 F9F9 F9F9 F9F7 2BF6 F6F6" + $"F6F6 FFFC FCFC 0000 0000 FFFF FFFF FFFF FFFF FFFF FFFF FFFF" + $"FFFF FFFF FFFF FFFF FFFF FFFC" +}; + +resource 'ICN#' (1000) { + { /* array: 2 elements */ + /* [1] */ + $"001F 8000 003F E000 00FF F000 FDF0 183E 83C0 07FE 81FF FFFE" + $"80E3 FFFC C073 FFFC 603B F9F8 381F F0F0 0C0F F030 0607 E018" + $"0600 300C 0E00 1806 0E00 0C03 0E00 C603 0E00 C303 0E00 C183" + $"0E00 C0C3 0E00 C067 0F00 E035 0700 E01D 0301 E019 0106 7019" + $"0118 7819 0368 1C19 02C8 0E3A 0740 077A 0640 03FC 0C00 07E0" + $"0800 0C00 0F7F F8", + /* [2] */ + $"001F 8000 003F E000 00FF F000 FDFF F83E FFFF FFFE FFFF FFFE" + $"FFFF FFFC FFFF FFFC 7FFF FFF8 3FFF FFF0 0FFF FFF0 07FF FFF8" + $"07FF FFFC 0FFF FFFE 0FFF FFFF 0FFF FFFF 0FFF FFFF 0FFF FFFF" + $"0FFF FFFF 0FFF FFFF 0FFF FFFF 07FF FFFF 03FF FFFF 01FF FFFF" + $"01FF FFFF 03FF FFFF 03FF FFFE 07FF FFFE 07FF FFFC 0FFF FFE0" + $"0FFF FC00 0FFF F8" + } +}; + +resource 'ICN#' (1001) { + { /* array: 2 elements */ + /* [1] */ + $"7FFF F000 4000 1800 4000 1400 407C 1200 4FC7 F100 49FF F080" + $"48FF FFC0 467C C040 433C 4040 4304 2040 4302 1040 4309 1040" + $"4308 F040 4308 5040 4138 5040 41E4 5040 43A2 6040 4203 C040" + $"43FE 0040 4000 0040 4000 0040 4000 0040 4000 0040 4CC0 0040" + $"4CC0 0040 4000 0040 4CC0 0060 4CC0 0078 4440 007E 4880 007E" + $"4000 0078 7FFF FFE0", + /* [2] */ + $"7FFF F000 7FFF F800 7FFF FC00 7FFF FE00 7FFF FF00 7FFF FF80" + $"7FFF FFC0 7FFF FFC0 7FFF FFC0 7FFF FFC0 7FFF FFC0 7FFF FFC0" + $"7FFF FFC0 7FFF FFC0 7FFF FFC0 7FFF FFC0 7FFF FFC0 7FFF FFC0" + $"7FFF FFC0 7FFF FFC0 7FFF FFC0 7FFF FFC0 7FFF FFC0 7FFF FFC0" + $"7FFF FFC0 7FFF FFC0 7FFF FFE0 7FFF FFF8 7FFF FFFE 7FFF FFFE" + $"7FFF FFF8 7FFF FFE0" + } +}; + +resource 'ICN#' (1002) { + { /* array: 2 elements */ + /* [1] */ + $"FFFF FF80 8000 0080 9980 00E0 9980 00A0 8000 00A0 9980 00A0" + $"9980 00A0 8880 00A0 9100 00A0 8000 00A0 8000 00A0 8000 00A0" + $"80F8 00A0 9F8F E0A0 93FF E0A0 91FF C0A0 8CF9 80A0 8678 80A0" + $"8608 40A0 8604 20A0 8612 20A0 8611 E0A0 8610 A0A0 8270 BFA0" + $"83C8 A120 8744 E220 8407 A430 87FC 283C 8000 303F FFFF E03F" + $"2000 003C 3FFF FFF0", + /* [2] */ + $"FFFF FF80 FFFF FF80 FFFF FFE0 FFFF FFE0 FFFF FFE0 FFFF FFE0" + $"FFFF FFE0 FFFF FFE0 FFFF FFE0 FFFF FFE0 FFFF FFE0 FFFF FFE0" + $"FFFF FFE0 FFFF FFE0 FFFF FFE0 FFFF FFE0 FFFF FFE0 FFFF FFE0" + $"FFFF FFE0 FFFF FFE0 FFFF FFE0 FFFF FFE0 FFFF FFE0 FFFF FFE0" + $"FFFF FFE0 FFFF FFE0 FFFF FFF0 FFFF FFFC FFFF FFFF FFFF FFFF" + $"3FFF FFFC 3FFF FFF0" + } +}; + +resource 'ics#' (1000) { + { /* array: 2 elements */ + /* [1] */ + $"07C0 FC7F 9FFF 8FFE 67CC 33C4 3042 3021 3091 308F 3085 1385" + $"1E45 3A26 203C 3FE0", + /* [2] */ + $"07C0 FFFF FFFF FFFE 7FFC 3FFC 3FFE 3FFF 3FFF 3FFF 3FFF 1FFF" + $"1FFF 3FFE 3FFC 3FE0" + } +}; + +resource 'ics#' (1001) { + { /* array: 2 elements */ + /* [1] */ + $"FFE0 8070 8058 8078 8008 8008 8008 B608 B608 8008 B608 B608" + $"9208 A40E 800F FFFE", + /* [2] */ + $"FFE0 FFF0 FFF8 FFF8 FFF8 FFF8 FFF8 FFF8 FFF8 FFF8 FFF8 FFF8" + $"FFF8 FFFE FFFF FFFE" + } +}; + +resource 'ics#' (1002) { + { /* array: 2 elements */ + /* [1] */ + $"FFF8 800C B60C B60C 800C B60C B60C 920C A40C 800C 800C 807C" + $"8054 8066 FFC7 7FFE", + /* [2] */ + $"FFF8 FFFC FFFC FFFC FFFC FFFC FFFC FFFC FFFC FFFC FFFC FFFC" + $"FFFC FFFE FFFF 7FFE" + } +}; + +resource 'ics4' (1000) { + $"0000 0FFF FF00 0000 FFFF FFBB BFFF FFFF FAAF FFFF FFFF FFFF" + $"FAAA FFFF FFFF FFF0 0FFA AFFF FFBB FF00 00FF AAFF FFAB BF00" + $"00FF AAAB BFAA BBF0 00FF AABB BBFA ABBF 00FF AABB FBBF AAAF" + $"00FF AABB FBBB FFFF 00FF AAAB FBBB BFBF 000F AA81 FBBB BFBF" + $"000F 818A AFBB BFBF 00FF 8A8A AAFB BFF0 00F8 AAAA AAFF FF00" + $"00FF FFFF FFF0" +}; + +resource 'ics4' (1001) { + $"FFFF FFFF FFF0 0000 F000 0000 0FFF 0000 F000 0000 0FCF F000" + $"F000 0000 0FFF F000 F000 0000 00CC F000 F000 0000 000C F000" + $"F000 0000 000C F000 F0FF 0FF0 000C F000 F0FF 0FF0 000C F000" + $"F000 0000 000C F000 F0FF 0FF0 000C F000 F0FF 0FF0 000C F000" + $"F00F 00F0 000C F000 F0F0 0F00 000C FEE0 F000 0000 000C FEEE" + $"FFFF FFFF FFFF FEE0" +}; + +resource 'ics4' (1002) { + $"FFFF FFFF FFFF F000 F000 0000 0000 FF00 F0FF 0FF0 0000 FF00" + $"F0FF 0FF0 0000 FF00 F000 0000 0000 FF00 F0FF 0FF0 0000 FF00" + $"F0FF 0FF0 0000 FF00 F00F 00F0 0000 FF00 F0F0 0F00 0000 FF00" + $"F000 0000 0000 FF00 F000 0000 0000 FF00 F000 0000 0FFF FF00" + $"F000 0000 0FCF DF00 F000 0000 0FFD CFE0 FFFF FFFF FFDC CFEE" + $"0FFF FFFF FFFF FFE0" +}; + +resource 'ics8' (1000) { + $"0000 0000 00FF FFFF FFFF 0000 0000 0000 FFFF FFFF FFFF 0808" + $"08FF FFFF FFFF FFFF FF33 33FF FFFF FFFF FFFF FFFF FFFF FFFF" + $"FF33 3333 FFFF FFFF FFFF FFFF FFFF FF00 00FF FF33 33FF FFFF" + $"FFFF 0808 FFFF 0000 0000 FFFF 3333 FFFF FFFF 3308 08FF 0000" + $"0000 FFFF 3333 3308 08FF 3333 0808 FF00 0000 FFFF 3333 0808" + $"0808 FF33 3308 08FF 0000 FFFF 3333 0808 FF08 08FF 3333 33FF" + $"0000 FFFF 3333 0808 FF08 0808 FFFF FFFF 0000 FFFF 3333 3308" + $"FF08 0808 08FF 08FF 0000 00FF 3333 E305 FF08 0808 08FF 08FF" + $"0000 00FF E305 E333 33FF 0808 08FF 08FF 0000 FFFF E333 E333" + $"3333 FF08 08FF FF00 0000 FFE3 3333 3333 3333 FFFF FFFF 0000" + $"0000 FFFF FFFF FFFF FFFF FF" +}; + +resource 'ics8' (1001) { + $"FFFF FFFF FFFF FFFF FFFF FF00 0000 0000 FFF5 F5F5 F5F5 F5F5" + $"F5FF FFFF 0000 0000 FFF5 F5F5 F5F5 F5F5 F5FF F6FF FF00 0000" + $"FFF5 F5F5 F5F5 F5F5 F5FF FFFF FF00 0000 FFF5 F5F5 F5F5 F5F5" + $"F5F5 F7F7 FF00 0000 FFF5 F5F5 F5F5 F5F5 F5F5 F5F7 FF00 0000" + $"FFF5 F5F5 F5F5 F5F5 F5F5 F5F7 FF00 0000 FFF5 FFFF F5FF FFF5" + $"F5F5 F5F7 FF00 0000 FFF5 FFFF F5FF FFF5 F5F5 F5F7 FF00 0000" + $"FFF5 F5F5 F5F5 F5F5 F5F5 F5F7 FF00 0000 FFF5 FFFF F5FF FFF5" + $"F5F5 F5F7 FF00 0000 FFF5 FFFF F5FF FFF5 F5F5 F5F7 FF00 0000" + $"FFF5 F5FF F5F5 FFF5 F5F5 F5F7 FF00 0000 FFF5 FFF5 F5FF F5F5" + $"F5F5 F5F7 FFFC FC00 FFF5 F5F5 F5F5 F5F5 F5F5 F5F7 FFFC FCFC" + $"FFFF FFFF FFFF FFFF FFFF FFFF FFFC FC" +}; + +resource 'ics8' (1002) { + $"FFFF FFFF FFFF FFFF FFFF FFFF FF00 0000 FFF5 F5F5 F5F5 F500" + $"F5F5 F5F5 FFFF 0000 FFF5 FFFF F5FF FF00 F5F5 F5F5 FFFF 0000" + $"FFF5 FFFF F5FF FF00 F5F5 F5F5 FFFF 0000 FFF5 F5F5 F5F5 F500" + $"F5F5 F5F5 FFFF 0000 FFF5 FFFF F5FF FF00 F5F5 F5F5 FFFF 0000" + $"FFF5 FFFF F5FF FF00 F5F5 F5F5 FFFF 0000 FFF5 F5FF F5F5 FF00" + $"F5F5 F5F5 FFFF 0000 FFF5 FFF5 F5FF F500 F5F5 F5F5 FFFF 0000" + $"FFF5 F5F5 F5F5 F500 F5F5 F5F5 FFFF 0000 FFF5 F5F5 F5F5 F5F5" + $"F5F5 F5F5 FFFF 0000 FFF5 F5F5 F5F5 F5F5 F5FF FFFF FFFF 0000" + $"FFF5 F5F5 F5F5 F5F5 F5FF F5FF F9FF 0000 FFF5 F5F5 F5F5 F5F5" + $"F5FF FFF9 F7FF FC00 FFFF FFFF FFFF FFFF FFFF F9F7 F7FF FCFC" + $"00FF FFFF FFFF FFFF FFFF FFFF FFFF FC" +}; + +resource 'FREF' (128) { + 'APPL', + 0, + "" +}; + +resource 'FREF' (129) { + 'TEXT', + 1, + "" +}; + +resource 'FREF' (130) { + 'sEXT', + 2, + "" +}; + +resource 'BNDL' (128) { + 'Caml', + 0, + { /* array TypeArray: 2 elements */ + /* [1] */ + 'FREF', + { /* array IDArray: 3 elements */ + /* [1] */ + 0, 128, + /* [2] */ + 1, 129, + /* [3] */ + 2, 130 + }, + /* [2] */ + 'ICN#', + { /* array IDArray: 3 elements */ + /* [1] */ + 0, 1000, + /* [2] */ + 1, 1001, + /* [3] */ + 2, 1002 + } + } +}; + +resource 'ICON' (1000) { + $"001F 8000 003F E000 00FF F000 FDF0 183E 83C0 07FE 81FF FFFE" + $"80E3 FFFC C073 FFFC 603B F9F8 381F F0F0 0C0F F030 0607 E018" + $"0600 300C 0E00 1806 0E00 0C03 0E00 C603 0E00 C303 0E00 C183" + $"0E00 C0C3 0E00 C067 0F00 E035 0700 E01D 0301 E019 0106 7019" + $"0118 7819 0368 1C19 02C8 0E3A 0740 077A 0640 03FC 0C00 07E0" + $"0800 0C00 0FFF F8" +}; + +data 'cicn' (1000) { + $"0000 0000 8010 0000 0000 0020 0020 0000 0000 0000 0000 0048" /* ....€...... . .........H */ + $"0000 0048 0000 0000 0004 0001 0004 0000 0000 0000 0000 0000" /* ...H.................... */ + $"0000 0000 0000 0004 0000 0000 0020 0020 0000 0000 0004 0000" /* ............. . ........ */ + $"0000 0020 0020 0000 0000 FFFF FFFF FFFF FFFF FFFF FFFF FFFF" /* ... . ....ÿÿÿÿÿÿÿÿÿÿÿÿÿÿ */ + $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF" /* ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ */ + $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF" /* ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ */ + $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF" /* ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ */ + $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF" /* ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ */ + $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF 001F 8000 003F" /* ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ..€..? */ + $"E000 00FF F000 FDF0 183E 83C0 07FE 81FF FFFE 80E3 FFFC C073" /* à..ÿð.ýð.>ƒÀ.þÿÿþ€ãÿüÀs */ + $"FFFC 603B F9F8 381F F0F0 0C0F F030 0607 E018 0600 300C 0E00" /* ÿü`;ùø8.ðð..ð0..à...0... */ + $"1806 0E00 0C03 0E00 C603 0E00 C303 0E00 C183 0E00 C0C3 0E00" /* ........Æ...Ã...Áƒ..ÀÃ.. */ + $"C067 0F00 E035 0700 E01D 0301 E019 0106 7019 0118 7819 0368" /* Àg..à5..à...à...p...x..h */ + $"1C19 02C8 0E3A 0740 077A 0640 03FC 0C00 07E0 0800 0C00 0FFF" /* ...È.:.@.z.@.ü...à.....ÿ */ + $"F800 0000 0000 0000 0007 0000 FFFF FFFF FFFF 0001 FFFF FFFF" /* ø...........ÿÿÿÿÿÿ..ÿÿÿÿ */ + $"0000 0002 CCCC 9999 6666 0003 8888 8888 8888 0004 DDDD DDDD" /* ....ÌÌ™™ff..ˆˆˆˆˆˆ..ÝÝÝÝ */ + $"DDDD 0005 FFFF CCCC 9999 0006 0000 BBBB 0000 000F 0000 0000" /* ÝÝ..ÿÿÌÌ™™....»»........ */ + $"0000 0000 0000 000F FFFF F000 0000 0000 0000 0000 0000 00FF" /* ........ÿÿð............ÿ */ + $"FFFF FFF0 0000 0000 0000 0000 0000 FFFF FFFF FFFF 0000 0000" /* ÿÿÿð..........ÿÿÿÿÿÿ.... */ + $"0000 FFFF FF0F FFFF 5555 555F F000 00FF FFF0 F222 22FF FF55" /* ..ÿÿÿ.ÿÿUUU_ð..ÿÿðò""ÿÿU */ + $"5555 5555 5FFF FFFF FFF0 F222 222F FFFF FFFF FFFF FFFF FFFF" /* UUUU_ÿÿÿÿðò""/ÿÿÿÿÿÿÿÿÿÿ */ + $"FFF0 F222 2222 FFF3 33FF FFFF FFFF FFFF FF00 FF22 2222 2FFF" /* ÿðò"""ÿó3ÿÿÿÿÿÿÿÿ.ÿ"""/ÿ */ + $"44FF FFFF FFFF FFFF FF00 0FF2 2222 22FF F4FF FFFF F55F FFFF" /* Dÿÿÿÿÿÿÿÿ..ò"""ÿôÿÿÿõ_ÿÿ */ + $"F000 00FF F222 222F FFFF FFFF 5555 FFFF 0000 0000 FF22 2222" /* ð..ÿò""/ÿÿÿÿUUÿÿ....ÿ""" */ + $"FFFF FFFF 5555 55FF 0000 0000 0FF2 2222 2FFF FFF2 2555 555F" /* ÿÿÿÿUUUÿ.....ò""/ÿÿò%UU_ */ + $"F000 0000 0FF2 2222 2555 55FF 2255 5555 FF00 0000 FFF2 2222" /* ð....ò""%UUÿ"UUUÿ...ÿò"" */ + $"5555 555F F225 5555 5FF0 0000 FFF2 2225 5555 5555 FF22 5555" /* UUU_ò%UU_ð..ÿò"%UUUUÿ"UU */ + $"55FF 0000 FFF2 2225 5555 FF55 5FF2 2555 55FF 0000 FFF2 2225" /* Uÿ..ÿò"%UUÿU_ò%UUÿ..ÿò"% */ + $"5555 FF55 55FF 2252 55FF 0000 FFF2 2225 5555 FF55 555F F222" /* UUÿUUÿ"RUÿ..ÿò"%UUÿUU_ò" */ + $"22FF 0000 FFF2 2225 5555 FF55 5555 FF22 22FF 0000 FFF2 2222" /* "ÿ..ÿò"%UUÿUUUÿ""ÿ..ÿò"" */ + $"5555 FF55 5555 5FF2 2FFF 0000 FFFF 2222 2555 FFF5 5555 55FF" /* UUÿUUU_ò/ÿ..ÿÿ""%UÿõUUUÿ */ + $"2F5F 0000 0FFF 2222 2255 FFF5 5555 555F FF5F 0000 00FF 2222" /* /_...ÿ"""UÿõUUU_ÿ_...ÿ"" */ + $"2221 61F5 5555 555F F55F 0000 000F 2222 2612 2FFF 5555 555F" /* "!aõUUU_õ_....""&./ÿUUU_ */ + $"F55F 0000 000F 2221 6222 2FFF F555 555F F55F 0000 00FF 2612" /* õ_...."!b"/ÿõUU_õ_...ÿ&. */ + $"1222 222F FF55 555F F55F 0000 00F2 1122 6222 2222 FFF5 55FF" /* .""/ÿUU_õ_...ò."b"""ÿõUÿ */ + $"F5F0 0000 0FF6 2622 2222 2222 2FFF 5FFF F5F0 0000 0F62 2622" /* õð...ö&"""""/ÿ_ÿõð...b&" */ + $"2222 2222 22FF FFFF FF00 0000 FF22 2222 2222 2222 2FFF FFF0" /* """""ÿÿÿÿ...ÿ"""""""/ÿÿð */ + $"0000 0000 F222 2222 2222 2222 FF00 0000 0000 0000 FFFF FFFF" /* ....ò"""""""ÿ.......ÿÿÿÿ */ + $"FFFF FFFF F000 0000 0000" /* ÿÿÿÿð..... */ +}; + +data 'Caml' (0) { + $"00" /* . */ +}; diff --git a/maccaml/prefs.c b/maccaml/prefs.c new file mode 100644 index 000000000..8f33bd9c2 --- /dev/null +++ b/maccaml/prefs.c @@ -0,0 +1,124 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +#define kPrefResource 1000 + +struct prefs prefs; +static struct prefs defpref; + +static void InitPrefs (void) +{ + TextStyle defstyle; + + defpref.version = PREF_VERSION; + defpref.asksavetop = 0; + WinToplevelStdState (&defpref.toppos); + WinClipboardStdState (&defpref.clippos); + GetFNum ("\pmonaco", &defstyle.tsFont); + defstyle.tsSize = 9; + defstyle.tsFace = 0; + defstyle.tsColor.red = 0; + defstyle.tsColor.green = 0; + defstyle.tsColor.blue = 0; + defpref.text = defpref.unread = defpref.input = defpref.output + = defpref.errors = defstyle; + + defpref.unread.tsColor.green = 42000; + defpref.output.tsColor.blue = 65535; + defpref.errors.tsColor.red = 65535; + defpref.errors.tsFace = underline; +} + +void ReadPrefs (void) +{ + short err; + short vrefnum; + long dirid; + short refnum = -1; + Handle prefsH = NULL; + Str255 prefsfilename; + FSSpec spec; + + InitPrefs (); + GetIndString (prefsfilename, kMiscStrings, kPrefsFileNameIdx); + err = FindFolder (kOnSystemDisk, kPreferencesFolderType, kCreateFolder, + &vrefnum, &dirid); + if (err != noErr) goto cantread; + err = FSMakeFSSpec (vrefnum, dirid, prefsfilename, &spec); + if (err != noErr) goto cantread; + refnum = FSpOpenResFile (&spec, fsRdPerm); + if (refnum == -1) goto cantread; + prefsH = Get1Resource ('Oprf', kPrefResource); + if (prefsH == NULL) goto cantread; + if (GetHandleSize (prefsH) != sizeof (prefs)) goto cantread; + if (**(long **)prefsH != PREF_VERSION) goto cantread; + memcpy (&prefs, *prefsH, sizeof (prefs)); + CloseResFile (refnum); + return; + + cantread: + if (refnum != -1) CloseResFile (refnum); + prefs = defpref; +} + +void WritePrefs (void) +{ + short err; + short vrefnum; + long dirid; + short refnum = -1; + Handle prefsH = NULL; + Str255 prefsfilename; + FSSpec spec; + Handle h; + + GetIndString (prefsfilename, kMiscStrings, kPrefsFileNameIdx); + err = FindFolder (kOnSystemDisk, kPreferencesFolderType, kCreateFolder, + &vrefnum, &dirid); + if (err != noErr) goto cantwrite; + err = FSMakeFSSpec (vrefnum, dirid, prefsfilename, &spec); + if (err != noErr && err != fnfErr) goto cantwrite; + + if (err == fnfErr){ + if (!memcmp (&prefs, &defpref, sizeof (prefs))) return; + else FSpCreateResFile (&spec, 0, 0, smSystemScript); + } + refnum = FSpOpenResFile (&spec, fsRdWrPerm); + if (refnum == -1) goto cantwrite; + + prefsH = Get1Resource ('Oprf', kPrefResource); + if (prefsH == NULL){ + err = AllocHandle (sizeof (prefs), (Handle *) &prefsH); + if (err != noErr) goto cantwrite; + AddResource (prefsH, 'Oprf', kPrefResource, "\pO'Caml prefs"); + } + SetHandleSize (prefsH, sizeof (prefs)); + if (MemError () != noErr) goto cantwrite; + memcpy (*prefsH, &prefs, sizeof (prefs)); + ChangedResource (prefsH); + + h = GetResource ('STR ', kPrefsDescriptionStr); + if (h != NULL){ + DetachResource (h); + AddResource (h, 'STR ', kApplicationMissing, NULL); + ChangedResource (h); + } + + CloseResFile (refnum); + return; + + cantwrite: + if (refnum != -1) CloseResFile (refnum); +} diff --git a/maccaml/scroll.c b/maccaml/scroll.c new file mode 100644 index 000000000..65a717d40 --- /dev/null +++ b/maccaml/scroll.c @@ -0,0 +1,325 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +WEScrollUPP scrollFollowUPP; +static ControlActionUPP scrollUPP, scrollGraphUPP; + +static long scroll_step = 1; + +/* Bring destRect in sync with the scroll bars. */ +static void AdjustView (WStatusH st) +{ + WEReference we = (*st)->we; + ControlHandle hbar = (*st)->scrollbars[H]; + ControlHandle vbar = (*st)->scrollbars[V]; + LongRect view, dest; + long dx, dy; + + Assert (hbar != NULL && vbar != NULL); + if ((*st)->kind != kWinGraphics){ + Assert (we != NULL); + WEGetViewRect (&view, we); + WEGetDestRect (&dest, we); + dx = view.left - dest.left - LCGetValue (hbar); + dy = view.top - dest.top - LCGetValue (vbar); + WEScroll (dx, dy, we); + }else{ + dx = (*st)->viewrect.left - (*st)->destrect.left - LCGetValue (hbar); + dy = (*st)->viewrect.top - (*st)->destrect.top - LCGetValue (vbar); + GraphScroll (dx, dy); + } +} + +/* Recompute the max values and the thumb positions. */ +void AdjustScrollBars (WindowPtr w) +{ + GrafPtr saveport; + WStatusH st; + LongRect view, dest; + long xmax, xval, ymax, yval; + long h; + + GetPort (&saveport); + SetPort (w); + + st = WinGetStatus (w); + Assert (st != NULL); + if ((*st)->kind == kWinGraphics){ + view = (*st)->viewrect; + dest = (*st)->destrect; + }else{ + WEGetViewRect (&view, (*st)->we); + WEGetDestRect (&dest, (*st)->we); + } + + yval = view.top - dest.top; + ymax = yval + (dest.bottom - view.bottom); + if (ymax < 0) ymax = 0; + + /* round up to nearest line_height */ + h = (*st)->line_height; + ymax = (ymax + h - 1) / h * h; + + LCSetMax ((*st)->scrollbars[V], ymax); + LCSetValue ((*st)->scrollbars[V], yval); + + xval = view.left - dest.left; + xmax = xval + (dest.right - view.right); + if (xmax < 0) xmax = 0; + LCSetMax ((*st)->scrollbars[H], xmax); + LCSetValue ((*st)->scrollbars[H], xval); + + if (xval > xmax || yval > ymax) AdjustView (st); + + SetPort (saveport); +} + +/* Callback procedure for auto-scrolling the text. (called by WASTE) */ +static pascal void Follow (WEReference we) +{ + WindowPtr w; + OSErr err; + + err = WEGetInfo (weRefCon, &w, we); + Assert (err == noErr); + AdjustScrollBars (w); +} + +/* Callback procedure for scrolling the text. (called by the Control Manager) */ +static pascal void Scroll (ControlHandle bar, ControlPartCode partcode) +{ + long value; + + if (partcode == kControlNoPart) return; + value = LCGetValue (bar); + if (value < LCGetMax (bar) && scroll_step > 0 + || value > 0 && scroll_step < 0){ + LCSetValue (bar, value + scroll_step); + AdjustView (WinGetStatus (FrontWindow ())); + } +} + +/* Callback procedure for scrolling the graphics. */ +static pascal void ScrollGraph (ControlHandle bar, ControlPartCode partcode) +{ + long value; + + if (partcode == kControlNoPart) return; + value = LCGetValue (bar); + if (value < LCGetMax (bar) && scroll_step > 0 + || value > 0 && scroll_step < 0){ + LCSetValue (bar, value + scroll_step); + AdjustView (WinGetStatus (FrontWindow ())); + } +} + +OSErr InitialiseScroll (void) +{ + scrollFollowUPP = NewWEScrollProc (Follow); + scrollUPP = NewControlActionProc (Scroll); + scrollGraphUPP = NewControlActionProc (ScrollGraph); + return noErr; +} + +/* Calculate the contents rectangle for a text window with scrollbars. */ +void ScrollCalcText (WindowPtr w, Rect *r) +{ + *r = w->portRect; + r->bottom -= kScrollBarWidth; + r->right -= kScrollBarWidth; + InsetRect (r, kTextMarginH, kTextMarginV); +} + +/* Calculate the contents rectangle for the graphics window. */ +void ScrollCalcGraph (WindowPtr w, Rect *r) +{ + *r = w->portRect; + r->bottom -= kScrollBarWidth; + r->right -= kScrollBarWidth; +} + +void ScrollDoClick (WindowPtr w, Point where, EventModifiers mods) +{ + switch (WinGetKind (w)){ + case kWinToplevel: + case kWinDocument: { + WEReference we = WinGetWE (w); + WStatusH st = WinGetStatus (w); + LongRect view; + ControlPartCode partcode; + ControlHandle bar; + long scrolldelta, pagesize; + + Assert (we != NULL && st != NULL); + WEGetViewRect (&view, we); + partcode = FindControl (where, w, &bar); + if (bar == (*st)->scrollbars[V]){ + pagesize = view.bottom - view.top; + scrolldelta = (*st)->line_height; + }else if (bar == (*st)->scrollbars [H]){ + pagesize = view.right - view.left; + scrolldelta = kHorizScrollDelta; + }else{ + return; + } + switch (partcode){ + case kControlIndicatorPart: + TrackControl (bar, where, NULL); + LCSynch (bar); + AdjustView (st); + return; + case kControlUpButtonPart: + scroll_step = - (mods & optionKey ? 1 : scrolldelta); + break; + case kControlDownButtonPart: + scroll_step = + (mods & optionKey ? 1 : scrolldelta); + break; + case kControlPageUpPart: + scroll_step = - (pagesize - scrolldelta) / scrolldelta * scrolldelta; + break; + case kControlPageDownPart: + scroll_step = + (pagesize - scrolldelta) / scrolldelta * scrolldelta; + break; + } + TrackControl (bar, where, scrollUPP); + break; + } + case kWinGraphics: { + WStatusH st = WinGetStatus (w); + ControlPartCode partcode; + ControlHandle bar; + long scrolldelta, pagesize; + + Assert (st != NULL); + partcode = FindControl (where, w, &bar); + scrolldelta = kGraphScrollDelta; + if (bar == (*st)->scrollbars[V]){ + pagesize = (*st)->viewrect.bottom - (*st)->viewrect.top; + }else if (bar == (*st)->scrollbars [H]){ + pagesize = (*st)->viewrect.right - (*st)->viewrect.left; + }else{ + return; + } + switch (partcode){ + case kControlIndicatorPart: + TrackControl (bar, where, NULL); + LCSynch (bar); + AdjustView (st); + return; + case kControlUpButtonPart: + scroll_step = - (mods & optionKey ? 1 : scrolldelta); + break; + case kControlDownButtonPart: + scroll_step = + (mods & optionKey ? 1 : scrolldelta); + break; + case kControlPageUpPart: + scroll_step = - (pagesize - scrolldelta) / scrolldelta * scrolldelta; + break; + case kControlPageDownPart: + scroll_step = + (pagesize - scrolldelta) / scrolldelta * scrolldelta; + break; + } + TrackControl (bar, where, scrollGraphUPP); + break; + } + case kWinPrefs: + case kWinAbout: + case kWinClipboard: + default: + Assert (0); /* These windows have no scroll bars. */ + break; + } +} + +/* Calculate and set the position of the scroll bars for w. + Draw the scroll bars and the grow icon, and validate their region. + Where applicable, this function must be called after WinWEResize or + WinGraphResize. + */ +void ScrollNewSize (WindowPtr w) +{ + Rect port = w->portRect; + WStatusH st = WinGetStatus (w); + Rect r; + ControlHandle bar; + GrafPtr saveport; + + Assert (st != NULL); + + GetPort (&saveport); + SetPort (w); + + bar = (*st)->scrollbars[H]; + r.left = port.left - 1; + r.right = port.right - kScrollBarWidth + 1; + r.top = port.bottom - kScrollBarWidth; + r.bottom = port.bottom + 1; + HideControl (bar); /* Invalidates the rectangle */ + MoveControl (bar, r.left, r.top); + SizeControl (bar, r.right - r.left, r.bottom - r.top); + /* Only show the scrollbar if the window is active. */ + if (FrontWindow () == w){ + ValidRect (&r); + ShowControl (bar); + } + + bar = (*st)->scrollbars[V]; + r.left = port.right - kScrollBarWidth; + r.right = port.right + 1; + r.top = port.top - 1; + r.bottom = port.bottom - kScrollBarWidth + 1; + HideControl (bar); /* Invalidates the rectangle */ + MoveControl (bar, r.left, r.top); + SizeControl (bar, r.right - r.left, r.bottom - r.top); + /* Only show the scrollbar if the window is active. */ + if (FrontWindow () == w){ + ValidRect (&r); + ShowControl (bar); + } + + r = w->portRect; + r.left = r.right - kScrollBarWidth; + r.top = r.bottom - kScrollBarWidth; + ValidRect (&r); + DrawGrowIcon (w); + + AdjustScrollBars (w); + + SetPort (saveport); +} + +/* Return 1 if the vertical scroll bar is at its max setting, 0 otherwise. + (With 1/2 line fudge factor.) +*/ +int ScrollAtEnd (WindowPtr w) +{ + WStatusH st = WinGetStatus (w); + long val, max; + + Assert (st != NULL); + val = LCGetValue ((*st)->scrollbars[V]); + max = LCGetMax ((*st)->scrollbars[V]); + return (val >= max - (*st)->line_height / 2); +} + +/* Scroll to the bottom of the document. */ +void ScrollToEnd (WindowPtr w) +{ + WStatusH st = WinGetStatus (w); + + Assert (st != NULL); + LCSetValue ((*st)->scrollbars[V], LCGetMax ((*st)->scrollbars[V])); + AdjustView (st); +} diff --git a/maccaml/windows.c b/maccaml/windows.c new file mode 100644 index 000000000..167905b48 --- /dev/null +++ b/maccaml/windows.c @@ -0,0 +1,806 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* Damien Doligez, projet Para, INRIA Rocquencourt */ +/* */ +/* Copyright 1998 Institut National de Recherche en Informatique et */ +/* en Automatique. Distributed only by permission */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include "main.h" + +WindowPtr winToplevel = NULL; +WindowPtr winGraphics = NULL; +long wintopfrontier = 0; + +static WELineBreakUPP charBreakUPP; + +/* WE hook for breaking line at char (not word) boundaries. */ +static pascal StyledLineBreakCode CharBreak + (Ptr pText, SInt32 textLength, SInt32 textStart, SInt32 textEnd, + Fixed *textWidth, SInt32 *textOffset, WEHandle hWE) +{ + long base = textStart; + long len = textEnd - textStart; + long l = 0; + long i; + short w; + short text_width = HiWord (*textWidth); + + while (len > 0){ + if (pText [base] == '\n'){ + *textOffset = base + 1; + return smBreakWord; + } + + l = len >= 128 ? 128 : len; + for (i = 0; i < l; i++){ + if (pText [base + i] == '\n') l = i; + } + + w = TextWidth (pText, base, l); + if (w > text_width){ + short locs [129]; + long i; + MeasureText (l, pText + base, (Ptr) locs); + for (i = 0; i < l; i++){ + if (locs [i+1] > text_width) break; + } + *textOffset = base + i; + return smBreakChar; + } + + len -= l; + base += l; + text_width -= w; + } + *textOffset = base; + *textWidth = FixRatio (text_width, 1); + return smBreakOverflow; +} + +static void UpdateToplevelRO (void) +{ + WEReference we = WinGetWE (winToplevel); + long selstart, selend; + + Assert (we != NULL); + WEGetSelection (&selstart, &selend, we); + if (selstart >= wintopfrontier){ + WEFeatureFlag (weFReadOnly, weBitClear, we); + }else{ + WEFeatureFlag (weFReadOnly, weBitSet, we); + } +} + +OSErr InitialiseWindows (void) +{ + charBreakUPP = NewWELineBreakProc (CharBreak); + return noErr; +} + +/* The window becomes active if [activate] is true, + inactive if false. +*/ +void WinActivateDeactivate (int activate, WindowPtr w) +{ + WStatusH st = WinGetStatus (w); + WEHandle we = WinGetWE (w); + VHSelect axis; + GrafPtr savePort; + + if (st == NULL) return; + + GetPort (&savePort); + SetPort (w); + + if (we != NULL){ + if (activate) WEActivate (we); else WEDeactivate (we); + } + for (axis = V; axis <= H; axis++){ + ControlHandle bar = (*st)->scrollbars[axis]; + if (bar != NULL){ + if (activate) ShowControl (bar); else HideControl (bar); + /* We sometimes get an activate without any previous deactivate. + In this case, ShowControl will do nothing, but the control + still needs to be redrawn. It will be done with the normal + update mechanism. In the normal case, the control will be + drawn twice, but what the hell. */ + /* ValidRect (&(*bar)->contrlRect); */ + } + } + /* There seems to be a bug in DrawGrowIcon that makes it draw an icon + for non-resizable windows when processing a suspend/resume event. + */ + if (GetWVariant (w) != noGrowDocProc) DrawGrowIcon (w); + + SetPort (savePort); +} + +void WinAdvanceTopFrontier (long length) +{ + wintopfrontier += length; + UpdateToplevelRO (); +} + +OSErr WinAllocStatus (WindowPtr w) +{ + WStatusH st = NULL; + OSErr err; + + err = AllocHandle (sizeof (struct WStatus), (Handle *) &st); + if (err != noErr) return err; + HLock ((Handle) st); + (*st)->kind = kWinUninitialised; + (*st)->datarefnum = (*st)->resrefnum = -1; + (*st)->canwritesel = 0; + (*st)->dirty = 0; + (*st)->basemodcount = 0; + (*st)->hascontents = 0; + (*st)->scrollbars [V] = NULL; + (*st)->scrollbars [H] = NULL; + /* XXX initialiser les rectangles */ + (*st)->line_height = 1; + (*st)->we = NULL; + HUnlock ((Handle) st); + SetWRefCon (w, (long) st); + return noErr; +} + +void WinCloseGraphics (void) +{ + Rect r; + GrafPtr saveport; + + Assert (winGraphics != NULL); + + GetPort (&saveport); + SetPort (winGraphics); + r = winGraphics->portRect; + LocalToGlobalRect (&r); + prefs.graphpos = r; + SetPort (saveport); + + DisposeWindow (winGraphics); + winGraphics = NULL; +} + +void WinCloseToplevel (void) +{ + Rect r; + GrafPtr saveport; + + if (winToplevel != NULL){ + GetPort (&saveport); + SetPort (winToplevel); + + r = winToplevel->portRect; + LocalToGlobalRect (&r); + prefs.toppos = r; + if (prefs.asksavetop){ + XXX (); + } + SetPort (saveport); + } + DisposeWindow (winToplevel); + winToplevel = NULL; +} + +void WinDoContentClick (EventRecord *event, WindowPtr w) +{ + int k = WinGetKind (w); + int inback = !IsWindowHilited (w); + + switch (k){ + + case kWinUnknown: + case kWinAbout: + case kWinClipboard: + if (inback) SelectWindow (w); + break; + + case kWinGraphics: { + Point hitPt = event->where; + GrafPtr saveport; + + GetPort (&saveport); + SetPort (w); + GlobalToLocal (&hitPt); + if (inback){ + SelectWindow (w); + }else{ + Rect r; + ScrollCalcGraph (w, &r); + if (PtInRect (hitPt, &r)){ + GraphGotEvent (event); + }else{ + ScrollDoClick (w, hitPt, event->modifiers); + } + } + SetPort (saveport); + break; + } + + case kWinToplevel: + case kWinDocument: { + int handleit = !inback; + GrafPtr saveport; + Point hitPt = event->where; + WEReference we = WinGetWE (w); + + Assert (we != NULL); + GetPort (&saveport); + SetPort (w); + GlobalToLocal (&hitPt); + + if (inback && gHasDragAndDrop){ + long selStart, selEnd; + RgnHandle selRgn; + + WEGetSelection (&selStart, &selEnd, we); + selRgn = WEGetHiliteRgn (selStart, selEnd, we); + handleit = PtInRgn (hitPt, selRgn) && WaitMouseMoved (event->where); + DisposeRgn (selRgn); + } + if (!handleit){ + SelectWindow (w); + }else{ + Rect r; + ScrollCalcText (w, &r); + InsetRect (&r, -kTextMarginH, 0); + if (PtInRect (hitPt, &r)){ + WEClick (hitPt, event->modifiers, event->when, we); + if (w == winToplevel) UpdateToplevelRO (); + }else{ + ScrollDoClick (w, hitPt, event->modifiers); + } + } + SetPort (saveport); + break; + } + + default: + Assert (0); /* There is no other window kind. */ + break; + } +} + +OSErr WinDoClose (ClosingOption close, WindowPtr w) +{ + int k = WinGetKind (w); + OSErr err; + WStatusH st; + WEHandle we; + + switch (k){ + + case kWinUnknown: + case kWinToplevel: + default: + Assert (0); + return noErr; + + case kWinAbout: + CloseAboutBox (w); + return noErr; + + case kWinGraphics: + HideWindow (winGraphics); + return noErr; + + case kWinDocument: + err = FileDoClose (w, close); + if (err != noErr) return err; + st = WinGetStatus (w); Assert (st != NULL); + we = WinGetWE (w); Assert (we != NULL); + LCDetach ((*st)->scrollbars[V]); + LCDetach ((*st)->scrollbars[H]); + WEDispose (we); + DisposeHandle ((Handle) st); + MenuWinRemove (w); + DisposeWindow (w); + return noErr; + + case kWinClipboard: + XXX (); + return noErr; + } +} + +void WinDoDrag (Point where, WindowPtr w) +{ + Rect limits; + + limits = (*GetGrayRgn ())->rgnBBox; + InsetRect (&limits, 4, 4); + DragWindow (w, where, &limits); + if (w == winGraphics) GraphNewSizePos (); +} + +/* Invalidate the bottom and right margins. */ +static void WinInvalMargins (WindowPtr w) +{ + Rect r; + + r = w->portRect; + r.right -= kScrollBarWidth; + r.left = r.right - kTextMarginH; + r.bottom -= kScrollBarWidth; + InvalRect (&r); + r = w->portRect; + r.bottom -= kScrollBarWidth; + r.top = r.bottom - kTextMarginV; + r.right -= kScrollBarWidth; + InvalRect (&r); +} + +static void WinGraphNewSize (WindowPtr w) +{ + Rect r; + WStatusH st = WinGetStatus (w); + + Assert (st != NULL); + ScrollCalcGraph (w, &r); + WERectToLongRect (&r, &(*st)->viewrect); +} + +static void WinWENewSize (WindowPtr w, WEReference we) +{ + Rect r; + LongRect lr; + + ScrollCalcText (w, &r); + WERectToLongRect (&r, &lr); + WESetViewRect (&lr, we); + WEGetDestRect (&lr, we); + if (lr.right - lr.left != r.right - r.left){ + lr.right = lr.left + r.right - r.left; + WESetDestRect (&lr, we); + WECalText (we); + InvalRect (&r); + } +} + +static void WinResize (WindowPtr w, short x, short y) +{ + GrafPtr saveport; + WEReference we = WinGetWE (w); + Rect r; + + GetPort (&saveport); + SetPort (w); + + /* Invalidate the old grow icon and the text margin. */ + r = w->portRect; + r.left = r.right - kScrollBarWidth; + r.top = r.bottom - kScrollBarWidth; + InvalRect (&r); + if (we != NULL) WinInvalMargins (w); + + SizeWindow (w, x, y, true); + + /* Redraw the controls and invalidate whatever is needed. */ + if (we != NULL){ + WinWENewSize (w, we); + WinInvalMargins (w); + } + if (w == winGraphics) WinGraphNewSize (w); + ScrollNewSize (w); + SetPort (saveport); +} + +void WinDoGrow (Point where, WindowPtr w) +{ + Rect r; + long newsize; + short x, y; + WStatusH st; + + switch (WinGetKind (w)){ + + case kWinUnknown: + case kWinAbout: + case kWinPrefs: + Assert (0); + break; + + case kWinToplevel: + case kWinDocument: + case kWinClipboard: + SetRect (&r, kMinWindowWidth, kMinWindowHeight, SHRT_MAX, SHRT_MAX); + break; + + case kWinGraphics: + st = WinGetStatus (w); + Assert (st != NULL); + x = (*st)->destrect.right - (*st)->destrect.left + kScrollBarWidth + 1; + y = (*st)->destrect.bottom - (*st)->destrect.top + kScrollBarWidth + 1; + SetRect (&r, kMinWindowWidth, kMinWindowHeight, x, y); + break; + } + newsize = GrowWindow (w, where, &r); + if (newsize != 0) WinResize (w, LoWord (newsize), HiWord (newsize)); +} + +void WinDoIdle (WindowPtr w) +{ + WEHandle we = WinGetWE (w); + + if (we != NULL) WEIdle (&evtSleep, we); else evtSleep = LONG_MAX; +} + +void WinDoKey (WindowPtr w, short chr, EventRecord *e) +{ + WEReference we; + long selstart, selend; + + switch (WinGetKind (w)){ + + case kWinToplevel: + we = WinGetWE (w); Assert (we != NULL); + WEGetSelection (&selstart, &selend, we); + if (chr == charBackspace){ + if (selstart < wintopfrontier || selend == wintopfrontier) break; + } + if (chr == charEnter){ + long sel = WEGetTextLength (we); + WESetSelection (sel, sel, we); + chr = charReturn; + } + if (selstart == selend){ + WESetStyle (weDoFont + weDoFace + weDoSize + weDoColor + weDoReplaceFace, + &prefs.unread, we); + } + /*XXX intercepter option-up/down, command-up/down, option-command-up/down */ + WEKey (chr, e->modifiers, we); + UpdateToplevelRO (); + break; + + case kWinDocument: + we = WinGetWE (w); Assert (we != NULL); + if (chr == charEnter){ + XXX (); /* XXX envoyer la phrase courante au toplevel */ + } + /*XXX intercepter option-up/down, command-up/down, option-command-up/down + -> myWEKey pour partager avec le toplevel */ + WEKey (chr, e->modifiers, we); + break; + + case kWinGraphics: + GraphGotEvent (e); + break; + + case kWinAbout: + CloseAboutBox (w); + break; + + case kWinPrefs: + XXX (); + break; + + case kWinClipboard: + break; + + default: + Assert (0); + break; + } +} + +void WinDoZoom (WindowPtr w, short partCode) +{ + XXX (); +} + +/* Return a pointer to the window's descriptor record, + NULL if there is none or w is NULL. +*/ +WStatusH WinGetStatus (WindowPtr w) +{ + WStatusH st; + short wk; + + if (w == NULL) return NULL; + wk = GetWindowKind (w); + if (wk != kApplicationWindowKind && wk != kDialogWindowKind) return NULL; + st = (WStatusH) GetWRefCon (w); + Assert (st != NULL); + return st; +} + +WEHandle WinGetWE (WindowPtr w) +{ + WStatusH st = WinGetStatus (w); + + if (st == NULL) return NULL; + return (*st)->we; +} + +int WinGetKind (WindowPtr w) +{ + WStatusH st = WinGetStatus (w); + + if (st == NULL) return kWinUnknown; + return (*st)->kind; +} + +/* Initialize all the data structures associated with a text + window: WE record and scroll bars. +*/ +static OSErr WinTextInit (WindowPtr w, TextStyle *style) +{ + OSErr err; + WEReference we = NULL; + WStatusH st = NULL; + Rect viewrect; + LongRect lviewrect, ldestrect; + WERunInfo runinfo; + int i; + ControlHandle bar; + + err = WinAllocStatus (w); + if (err != noErr) goto failed; + + st = WinGetStatus (w); Assert (st != NULL); + HLock ((Handle) st); + + ScrollCalcText (w, &viewrect); + WERectToLongRect (&viewrect, &lviewrect); + ldestrect = lviewrect; + ldestrect.right = ldestrect.left + ktextwidth; + err = WENew (&ldestrect, &lviewrect, + weDoAutoScroll + weDoOutlineHilite + weDoUndo + + weDoDragAndDrop + weDoUseTempMem + weDoDrawOffscreen + + weDoMonoStyled, + &we); + if (err != noErr) goto failed; + WESetAlignment (weFlushLeft, we); + WESetStyle (weDoFont + weDoFace + weDoSize + weDoColor + weDoReplaceFace, + style, we); + err = WESetInfo (weRefCon, &w, we); Assert (err == noErr); + err = WESetInfo (weScrollProc, &scrollFollowUPP, we); Assert (err == noErr); + err = WESetInfo (weLineBreakHook, &charBreakUPP, we); Assert (err == noErr); + /* XXX ajouter un hiliteDropAreaHook pour les marges asymetriques. */ + (*st)->we = we; + + WEGetRunInfo (0, &runinfo, we); + (*st)->line_height = runinfo.runHeight; + + (*st)->scrollbars [H] = (*st)->scrollbars [V] = NULL; + for (i = V; i <= H; i++){ + bar = GetNewControl (kScrollBarTemplate, w); + if (bar == NULL){ err = memFullErr; goto failed; } + err = LCAttach (bar); + if (err != noErr) goto failed; + (*st)->scrollbars [i] = bar; + } + + HUnlock ((Handle) st); + + WinWENewSize (w, we); + ScrollNewSize (w); + + return noErr; + + failed: + if (we != NULL) WEDispose (we); + if (st != NULL){ + if ((*st)->scrollbars [V] != NULL) LCDetach ((*st)->scrollbars[V]); + if ((*st)->scrollbars [H] != NULL) LCDetach ((*st)->scrollbars[H]); + DisposeHandle ((Handle) st); + } + return err; +} + +/* Open a new empty document window. + In case of failure, display an alert and return NULL. +*/ +WindowPtr WinOpenDocument (StringPtr name) +{ + WStatusH st = NULL; + WindowPtr w = NULL; + OSErr err; + + w = GetNewCWindow (kDocumentWinTemplate, NULL, (WindowPtr) -1L); + if (w == NULL){ err = memFullErr; goto failed; } + + SetWTitle (w, name); + ShowWindow (w); + SetPort (w); + + err = WinTextInit (w, &prefs.text); + if (err != noErr) goto failed; + + st = WinGetStatus (w); Assert (st != NULL); + (*st)->kind = kWinDocument; + (*st)->hascontents = 1; + (*st)->canwritesel = 1; + + err = MenuWinAdd (w); + if (err != noErr) goto failed; + + return w; + + failed: + if (w != NULL) DisposeWindow (w); /* Also deallocates the scroll bars. */ + ErrorAlertGeneric (err); + return NULL; +} + +OSErr WinOpenGraphics (long width, long height) +{ + WindowPtr w = NULL; + WStatusH st = NULL; + OSErr err; + Rect r; + int i; + ControlHandle bar; + long ww, hh; + + w = GetNewCWindow (kGraphicsWinTemplate, NULL, (WindowPtr) -1L); + if (w == NULL){ err = memFullErr; goto failed; } + + /*XXX Calculer si la fenetre est hors de l'ecran -> stdstate */ + MoveWindow (w, prefs.graphpos.left, prefs.graphpos.top, false); + ww = prefs.graphpos.right - prefs.graphpos.left; + hh = prefs.graphpos.bottom - prefs.graphpos.top; + if (ww > width + kScrollBarWidth) ww = width + kScrollBarWidth; + if (hh > height + kScrollBarWidth) hh = height + kScrollBarWidth; + SizeWindow (w, ww, hh, false); + ShowWindow (w); + SetPort (w); + + err = WinAllocStatus (w); + if (err != noErr) goto failed; + + st = WinGetStatus (w); Assert (st != NULL); + HLock ((Handle) st); + + ScrollCalcGraph (w, &r); + WERectToLongRect (&r, &(*st)->viewrect); + r.right = r.left + width; + r.bottom = r.top + height; + WERectToLongRect (&r, &(*st)->destrect); + st = WinGetStatus (w); Assert (st != NULL); + (*st)->kind = kWinGraphics; + (*st)->hascontents = 1; + + (*st)->scrollbars [H] = (*st)->scrollbars [V] = NULL; + for (i = V; i <= H; i++){ + bar = GetNewControl (kScrollBarTemplate, w); + if (bar == NULL){ err = memFullErr; goto failed; } + err = LCAttach (bar); + if (err != noErr) goto failed; + (*st)->scrollbars [i] = bar; + } + + HUnlock ((Handle) st); + + ScrollNewSize (w); + winGraphics = w; + return noErr; + + failed: + if (st != NULL){ + if ((*st)->scrollbars [V] != NULL) LCDetach ((*st)->scrollbars[V]); + if ((*st)->scrollbars [H] != NULL) LCDetach ((*st)->scrollbars[H]); + DisposeHandle ((Handle) st); + } + winGraphics = NULL; + if (w != NULL) DisposeWindow (w); /* Also deallocates the scroll bars. */ + return err; +} + +OSErr WinOpenToplevel (void) +{ + WindowPtr w = NULL; + WStatusH st = NULL; + WEHandle we = NULL; + OSErr err; + + /* Open the toplevel behind all other windows. */ + w = GetNewCWindow (kToplevelWinTemplate, NULL, NULL); + if (w == NULL){ err = memFullErr; goto failed; } + + /*XXX Calculer si la fenetre est hors de l'ecran -> stdstate */ + MoveWindow (w, prefs.toppos.left, prefs.toppos.top, false); + SizeWindow (w, prefs.toppos.right - prefs.toppos.left, + prefs.toppos.bottom - prefs.toppos.top, false); + ShowWindow (w); + SetPort (w); + + err = WinTextInit (w, &prefs.unread); + if (err != noErr) goto failed; + + st = WinGetStatus (w); Assert (st != NULL); + (*st)->kind = kWinToplevel; + (*st)->hascontents = 1; + + we = WinGetWE (w); Assert (we != NULL); + WEFeatureFlag (weFUndo, weBitClear, we); + WEFeatureFlag (weFMonoStyled, weBitClear, we); + + winToplevel = w; + return noErr; + + failed: + winToplevel = NULL; + if (w != NULL) DisposeWindow (w); /* Also deallocates the scroll bars. */ + ErrorAlertGeneric (err); + return err; +} + +void WinClipboardStdState (Rect *r) +{ + *r = (*GetGrayRgn ())->rgnBBox; + r->bottom -= kWinBorderSpace; + r->top = r->bottom - kMinWindowHeight; + r->left += kWinBorderSpace; + r->right -= 100; +} + +void WinToplevelStdState (Rect *r) +{ + *r = (*GetGrayRgn ())->rgnBBox; + r->top += kTitleBarSpace; + r->bottom -= kPowerStripSpace; + r->left += kWinBorderSpace; + if (r->right > r->left + 506) r->right = r->left + 506; +} + +void WinUpdate (WindowPtr w) +{ + int k = WinGetKind (w); + WEHandle we = WinGetWE (w); + GrafPtr saveport; + RgnHandle updateRgn; + + Assert (k != kWinUnknown); + + GetPort (&saveport); + SetPort (w); + BeginUpdate (w); + updateRgn = w->visRgn; + if (!EmptyRgn (updateRgn)){ + EraseRgn (updateRgn); + UpdateControls (w, updateRgn); + DrawGrowIcon (w); + if (k == kWinGraphics) GraphUpdate (); + if (we != NULL) WEUpdate (updateRgn, we); + } + EndUpdate (w); + SetPort (saveport); +} + +void WinUpdateStatus (WindowPtr w) +{ + long selstart, selend, len; + WStatusH st = WinGetStatus (w); + WEHandle we = WinGetWE (w); + + if (st == NULL) return; + switch ((*st)->kind){ + case kWinUnknown: + case kWinUninitialised: + case kWinAbout: + case kWinPrefs: + case kWinClipboard: + case kWinGraphics: + break; + case kWinToplevel: + Assert (we != NULL); + WEGetSelection (&selstart, &selend, we); + len = WEGetTextLength (we); + (*st)->canwritesel = (selstart >= wintopfrontier); + break; + case kWinDocument: + Assert (we != NULL); + (*st)->dirty = ((*st)->basemodcount != WEGetModCount (we)); + break; + default: Assert (0); + } +} diff --git a/otherlibs/graph/Makefile.Mac b/otherlibs/graph/Makefile.Mac new file mode 100644 index 000000000..d5b97c01d --- /dev/null +++ b/otherlibs/graph/Makefile.Mac @@ -0,0 +1,25 @@ +CAMLC = :::boot:ocamlrun :::boot:ocamlc -I :::stdlib: + +all Ä graphics.cmi graphics.cma + set status 0 + +graphics.cma Ä graphics.cmo + {CAMLC} -a -o graphics.cma graphics.cmo + +partialclean Ä + delete -i Å.cm[aio] || set status 0 + +clean Ä partialclean + set status 0 + +install Ä + duplicate -y graphics.cm[ia] graphics.mli "{LIBDIR}" + +.cmi Ä .mli + {CAMLC} -c {default}.mli + +.cmo Ä .ml + {CAMLC} -c {default}.ml + +depend Ä + :::boot:ocamlrun :::tools:ocamldep Å.mli Å.ml > Makefile.Mac.depend diff --git a/otherlibs/graph/Makefile.Mac.depend b/otherlibs/graph/Makefile.Mac.depend new file mode 100644 index 000000000..2f452e72d --- /dev/null +++ b/otherlibs/graph/Makefile.Mac.depend @@ -0,0 +1,2 @@ +graphics.cmoÄ graphics.cmi +graphics.cmxÄ graphics.cmi diff --git a/otherlibs/graph/draw.c b/otherlibs/graph/draw.c index c86fe119b..4b565b201 100644 --- a/otherlibs/graph/draw.c +++ b/otherlibs/graph/draw.c @@ -82,6 +82,7 @@ value gr_draw_arc(value *argv, int argc) value gr_set_line_width(value vwidth) { int width = Int_val(vwidth); + gr_check_open(); XSetLineAttributes(grdisplay, grwindow.gc, width, LineSolid, CapRound, JoinRound); diff --git a/otherlibs/graph/graphics.mli b/otherlibs/graph/graphics.mli index 55fc1b3b0..5968bd690 100644 --- a/otherlibs/graph/graphics.mli +++ b/otherlibs/graph/graphics.mli @@ -5,7 +5,7 @@ (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) (* *) (* Copyright 1996 Institut National de Recherche en Informatique et *) -(* Automatique. Distributed only by permission. *) +(* en Automatique. Distributed only by permission. *) (* *) (***********************************************************************) @@ -20,11 +20,11 @@ exception Graphic_failure of string val open_graph: string -> unit (* Show the graphics window or switch the screen to graphic mode. - The graphics window is cleared. The string argument is used to - pass optional information on the desired graphics mode, the - graphics window size, and so on. Its interpretation is - implementation-dependent. If the empty string is given, a sensible - default is selected. *) + The graphics window is cleared and the current point is set + to (0, 0). The string argument is used to pass optional + information on the desired graphics mode, the graphics window + size, and so on. Its interpretation is implementation-dependent. + If the empty string is given, a sensible default is selected. *) val close_graph: unit -> unit (* Delete the graphics window or switch the screen back to text mode. *) @@ -123,7 +123,7 @@ external text_size : string -> int * int = "gr_text_size" external fill_rect : int -> int -> int -> int -> unit = "gr_fill_rect" (* [fill_rect x y w h] fills the rectangle with lower left corner - at [x,y], width [w] and heigth [h], with the current color. *) + at [x,y], width [w] and height [h], with the current color. *) external fill_poly : (int * int) array -> unit = "gr_fill_poly" (* Fill the given polygon with the current color. The array contains the coordinates of the vertices of the polygon. *) @@ -167,12 +167,14 @@ val get_image : int -> int -> int -> int -> image external create_image : int -> int -> image = "gr_create_image" (* [create_image w h] returns a new image [w] pixels wide and [h] pixels tall, to be used in conjunction with [blit_image]. - The initial image contents are random. *) + The initial image contents are random, except that no point + is transparent. *) external blit_image : image -> int -> int -> unit = "gr_blit_image" (* [blit_image img x y] copies screen pixels into the image [img], modifying [img] in-place. The pixels copied are those inside the rectangle with lower left corner at [x,y], and width and height - equal to those of the image. *) + equal to those of the image. Pixels that were transparent in + [img] are left unchanged. *) (*** Mouse and keyboard events *) diff --git a/parsing/location.ml b/parsing/location.ml index ab334c0ba..9d5cb26cf 100644 --- a/parsing/location.ml +++ b/parsing/location.ml @@ -18,7 +18,7 @@ type t = let none = { loc_start = -1; loc_end = -1 } -let symbol_loc () = +let symbol_loc () = { loc_start = Parsing.symbol_start(); loc_end = Parsing.symbol_end() } let rhs_loc n = @@ -60,20 +60,21 @@ let rec highlight_locations loc1 loc2 = (* If too many lines, give up *) if !lines >= num_lines - 2 then raise Exit; (* Move cursor up that number of lines *) - Terminfo.backup !lines; + flush stdout; Terminfo.backup !lines; (* Print the input, switching to standout for the location *) let bol = ref false in - print_string "# "; + print_string "# "; for pos = 0 to String.length lb.lex_buffer - pos0 - 1 do if !bol then (print_string " "; bol := false); if pos = loc1.loc_start || pos = loc2.loc_start then - Terminfo.standout true; + (flush stdout; Terminfo.standout true); if pos = loc1.loc_end || pos = loc2.loc_end then - Terminfo.standout false; + (flush stdout; Terminfo.standout false); let c = lb.lex_buffer.[pos + pos0] in print_char c; bol := (c = '\n') done; + flush stdout; (* Make sure standout mode is over *) Terminfo.standout false; (* Position cursor back to original location *) @@ -124,4 +125,3 @@ let print_warning loc msg = let echo_eof () = print_newline (); incr num_loc_lines - diff --git a/yacc/Makefile.Mac b/yacc/Makefile.Mac index 4b4c62e70..9653a32d9 100644 --- a/yacc/Makefile.Mac +++ b/yacc/Makefile.Mac @@ -16,12 +16,12 @@ PPCLibs = "{sharedlibraries}MathLib" "{ppclibraries}PPCCRuntime.o" ¶ OBJS = closure.c.o error.c.o lalr.c.o lr0.c.o main.c.o mkpar.c.o output.c.o ¶ reader.c.o skeleton.c.o symtab.c.o verbose.c.o warshall.c.o ¶ - ::byterun:rotatecursor.c.o + rotatecursor.c.o PPCOBJS = closure.c.x error.c.x lalr.c.x lr0.c.x main.c.x mkpar.c.x ¶ output.c.x ¶ reader.c.x skeleton.c.x symtab.c.x verbose.c.x warshall.c.x ¶ - ::byterun:rotatecursor.c.x + rotatecursor.c.x all Ä ocamlyacc @@ -35,11 +35,11 @@ clean Ä delete -i Å.c.[ox] || set status 0 delete -i ocamlyacc -::byterun:rotatecursor.c.o Ä ::byterun:rotatecursor.c ::byterun:rotatecursor.h - directory ::byterun; domake rotatecursor.c.o; directory ::yacc +rotatecursor.c.o Ä ::byterun:rotatecursor.c ::byterun:rotatecursor.h + {c} {coptions} -I ::byterun: -o rotatecursor.c.o ::byterun:rotatecursor.c -::byterun:rotatecursor.c.x Ä ::byterun:rotatecursor.c ::byterun:rotatecursor.h - directory ::byterun; domake rotatecursor.c.x; directory ::yacc +rotatecursor.c.x Ä ::byterun:rotatecursor.c ::byterun:rotatecursor.h + {ppcc} {ppccoptions} -I ::byterun: -o rotatecursor.c.x ::byterun:rotatecursor.c depend Ä diff --git a/yacc/main.c b/yacc/main.c index f75670611..18d19f851 100644 --- a/yacc/main.c +++ b/yacc/main.c @@ -375,14 +375,10 @@ void open_files(void) open_error(interface_file_name); } -#if macintosh -int volatile have_to_interact; -#endif - void main(int argc, char **argv) { #if macintosh - rotatecursor_init (&have_to_interact, NULL); + rotatecursor_init (&have_to_interact); #endif set_signals(); getargs(argc, argv); |