write

From: Doug Coleman Date: Sun, 4 Jun 2017 20:42:09 +0000 (-0500) Subject: unmaintained: New home for misfit Factor vocabularies. X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor-unmaintained.git;a=commitdiff_plain;h=649171903f74bf8f21f74045cc0b3a900bdc8cf6 unmaintained: New home for misfit Factor vocabularies. --- diff --git a/4DNav/4DNav-docs.factor b/4DNav/4DNav-docs.factor new file mode 100644 index 0000000..6f63f2e --- /dev/null +++ b/4DNav/4DNav-docs.factor @@ -0,0 +1,201 @@ +! Copyright (C) 2008 Jean-François Bigot. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations strings ; +IN: 4DNav + + +HELP: menu-3D +{ $values + { "gadget" "gadget" } +} +{ $description "The menu dedicated to 3D movements of the camera" } ; + +HELP: menu-4D +{ $values + + { "gadget" "gadget" } +} +{ $description "The menu dedicated to 4D movements of space" } ; + +HELP: menu-bar +{ $values + + { "gadget" "gadget" } +} +{ $description "return gadget containing menu buttons" } ; + +HELP: model-projection +{ $values + { "x" "interger" } + { "space" "space" } +} +{ $description "Project space following coordinate x" } ; + +HELP: mvt-3D-1 +{ $values + + { "quot" "quotation" } +} +{ $description "return a quotation to orientate space to see it from first point of view" } ; + +HELP: mvt-3D-2 +{ $values + + { "quot" "quotation" } +} +{ $description "return a quotation to orientate space to see it from second point of view" } ; + +HELP: mvt-3D-3 +{ $values + + { "quot" "quotation" } +} +{ $description "return a quotation to orientate space to see it from third point of view" } ; + +HELP: mvt-3D-4 +{ $values + + { "quot" "quotation" } +} +{ $description "return a quotation to orientate space to see it from first point of view" } ; + +HELP: load-model-file +{ $description "load space from file" } ; + +HELP: rotation-4D +{ $values + { "m" "a rotation matrix" } +} +{ $description "Apply a 4D rotation matrix" } ; + +HELP: translation-4D +{ $values + { "v" "vector" } +} +{ $description "Apply a 4D translation" } ; + + +ARTICLE: "implementation details" "How 4DNav is done" +"4DNav is build using :" + +{ $subsections + "4DNav.camera" + "adsoda-main-page" +} +; + +ARTICLE: "Space file" "Create a new space file" +"To build a new space, create an XML file using " { $vocab-link "adsoda" } " model description. A solid is not caracterized by its corners but is defined as the intersection of hyperplanes." + +$nl +"An example is:" +{ $code """ + + + 4 + + 4cube1 + 4 + 1,0,0,0,100 + -1,0,0,0,-150 + 0,1,0,0,100 + 0,-1,0,0,-150 + 0,0,1,0,100 + 0,0,-1,0,-150 + 0,0,0,1,100 + 0,0,0,-1,-150 + 1,0,0 + + + 4triancube + 4 + 1,0,0,0,160 + -0.4999999999999998,-0.8660254037844387,0,0,-130 + -0.5000000000000004,0.8660254037844384,0,0,-130 + 0,0,1,0,140 + 0,0,-1,0,-180 + 0,0,0,1,110 + 0,0,0,-1,-180 + 0,1,0 + + + triangone + 4 + 1,0,0,0,60 + 0.5,0.8660254037844386,0,0,60 + -0.5,0.8660254037844387,0,0,-20 + -1.0,0,0,0,-100 + -0.5,-0.8660254037844384,0,0,-100 + 0.5,-0.8660254037844387,0,0,-20 + 0,0,1,0,120 + 0,0,-0.4999999999999998,-0.8660254037844387,-120 + 0,0,-0.5000000000000004,0.8660254037844384,-120 + 0,1,1 + + + 1,1,1,1 + 0.2,0.2,0.6 + + 0.8,0.9,0.9 + +""" } ; + +ARTICLE: "TODO" "Todo" +{ $list + "A vocab to initialize parameters" + "an editor mode" + { $list "add a face to a solid" + "add a solid to the space" + "move a face" + "move a solid" + "select a solid in a list" + "select a face" + "display selected face" + "edit a solid color" + "add a light" + "edit a light color" + "move a light" + } + "add a tool wich give an hyperplane normal vector with enought points. Will use adsoda.intersect-hyperplanes with { { 0 } { 0 } { 1 } } " + "decorrelate 3D camera and activate them with select buttons" + +} ; + + +ARTICLE: "4DNav" "The 4DNav app" +{ $vocab-link "4DNav" } +$nl +{ $heading "4D Navigator" } +"4DNav is a simple tool to visualize 4 dimensionnal objects." +$nl +"It uses " { $vocab-link "adsoda" } " library to display a 4D space and navigate thru it." +$nl +"It will display:" +{ $list + { "a menu window" } + { "4 visualization windows" } +} +"Each visualization window represents the projection of the 4D space on a particular 3D space." + +{ $heading "Start" } +"type:" { $code "\"4DNav\" run" } + +{ $heading "Navigation" } +"Menu window is divided in 4 areas" +{ $list + { "a space-file chooser to select the file to display" } + { "a parametrization area to select the projection mode" } + { "4D submenu to translate and rotate the 4D space" } + { "3D submenu to move the camera in 3D space. Cameras in every 3D spaces are manipulated as a single one" } + } + +{ $heading "Links" } +{ $subsections + "Space file" + "TODO" + "implementation details" +} + +; + +ABOUT: "4DNav" diff --git a/4DNav/4DNav.factor b/4DNav/4DNav.factor new file mode 100644 index 0000000..8ba0788 --- /dev/null +++ b/4DNav/4DNav.factor @@ -0,0 +1,567 @@ +! Copyright (C) 2008 Jeff Bigot +! See http://factorcode.org/license.txt for BSD license. +USING: kernel +namespaces +accessors +assocs +make +math +math.functions +math.trig +math.parser +hashtables +sequences +combinators +continuations +colors +colors.constants +prettyprint +vars +quotations +io +io.directories +io.pathnames +help.markup +io.files +ui.gadgets.panes + ui + ui.gadgets + ui.traverse + ui.gadgets.borders + ui.gadgets.frames + ui.gadgets.tracks + ui.gadgets.labels + ui.gadgets.labeled + ui.gadgets.lists + ui.gadgets.buttons + ui.gadgets.packs + ui.gadgets.grids + ui.gadgets.corners + ui.gestures + ui.gadgets.scrollers +splitting +vectors +math.vectors +values +4DNav.turtle +4DNav.window3D +4DNav.deep +4DNav.space-file-decoder +models +fry +adsoda +adsoda.tools +; +QUALIFIED-WITH: ui.pens.solid s +QUALIFIED-WITH: ui.gadgets.wrappers w + + +IN: 4DNav +VALUE: selected-file +VALUE: translation-step +VALUE: rotation-step + +3 \ translation-step set-value +5 \ rotation-step set-value + +VAR: selected-file-model +VAR: observer3d +VAR: view1 +VAR: view2 +VAR: view3 +VAR: view4 +VAR: present-space + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! namespace utilities + +: closed-quot ( quot -- quot ) + namestack swap '[ namestack [ _ set-namestack @ ] dip set-namestack ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! waiting for deep-cleave-quots + +: 4D-Rxy ( angle -- Rx ) deg>rad +[ 1.0 , 0.0 , 0.0 , 0.0 , + 0.0 , 1.0 , 0.0 , 0.0 , + 0.0 , 0.0 , dup cos , dup sin neg , + 0.0 , 0.0 , dup sin , dup cos , ] 4 make-matrix nip ; + +: 4D-Rxz ( angle -- Ry ) deg>rad +[ 1.0 , 0.0 , 0.0 , 0.0 , + 0.0 , dup cos , 0.0 , dup sin neg , + 0.0 , 0.0 , 1.0 , 0.0 , + 0.0 , dup sin , 0.0 , dup cos , ] 4 make-matrix nip ; + +: 4D-Rxw ( angle -- Rz ) deg>rad +[ 1.0 , 0.0 , 0.0 , 0.0 , + 0.0 , dup cos , dup sin neg , 0.0 , + 0.0 , dup sin , dup cos , 0.0 , + 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ; + +: 4D-Ryz ( angle -- Rx ) deg>rad +[ dup cos , 0.0 , 0.0 , dup sin neg , + 0.0 , 1.0 , 0.0 , 0.0 , + 0.0 , 0.0 , 1.0 , 0.0 , + dup sin , 0.0 , 0.0 , dup cos , ] 4 make-matrix nip ; + +: 4D-Ryw ( angle -- Ry ) deg>rad +[ dup cos , 0.0 , dup sin neg , 0.0 , + 0.0 , 1.0 , 0.0 , 0.0 , + dup sin , 0.0 , dup cos , 0.0 , + 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ; + +: 4D-Rzw ( angle -- Rz ) deg>rad +[ dup cos , dup sin neg , 0.0 , 0.0 , + dup sin , dup cos , 0.0 , 0.0 , + 0.0 , 0.0 , 1.0 , 0.0 , + 0.0 , 0.0 , 0.0 , 1.0 , ] 4 make-matrix nip ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! UI +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: button* ( string quot -- button ) + closed-quot ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: model-projection-chooser ( -- gadget ) + observer3d> projection-mode>> + { { 1 "perspective" } { 0 "orthogonal" } } + ; + +: collision-detection-chooser ( -- gadget ) + observer3d> collision-mode>> + { { t "on" } { f "off" } } ; + +: model-projection ( x -- space ) + present-space> swap space-project ; + +: update-observer-projections ( -- ) + view1> relayout-1 + view2> relayout-1 + view3> relayout-1 + view4> relayout-1 ; + +: update-model-projections ( -- ) + 0 model-projection view1> model<< + 1 model-projection view2> model<< + 2 model-projection view3> model<< + 3 model-projection view4> model<< ; + +: camera-action ( quot -- quot ) + '[ drop _ observer3d> + with-self update-observer-projections ] + closed-quot ; + +: win3D ( text gadget -- ) + "navigateur 4D : " rot append open-window ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! 4D object manipulation +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: (mvt-4D) ( quot -- ) + present-space> + swap call space-ensure-solids + >present-space + update-model-projections + update-observer-projections ; inline + +: rotation-4D ( m -- ) + '[ _ [ [ middle-of-space dup vneg ] keep + swap space-translate ] dip + space-transform + swap space-translate + ] (mvt-4D) ; + +: translation-4D ( v -- ) '[ _ space-translate ] (mvt-4D) ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! menu +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: menu-rotations-4D ( -- gadget ) + 3 3 + { 1 1 } >>filled-cell + 1 >>fill + "XY +" [ drop rotation-step 4D-Rxy rotation-4D ] + button* add-gadget + "XY -" [ drop rotation-step neg 4D-Rxy rotation-4D ] + button* add-gadget + @top-left grid-add + 1 >>fill + "XZ +" [ drop rotation-step 4D-Rxz rotation-4D ] + button* add-gadget + "XZ -" [ drop rotation-step neg 4D-Rxz rotation-4D ] + button* add-gadget + @top grid-add + 1 >>fill + "YZ +" [ drop rotation-step 4D-Ryz rotation-4D ] + button* add-gadget + "YZ -" [ drop rotation-step neg 4D-Ryz rotation-4D ] + button* add-gadget + @center grid-add + 1 >>fill + "XW +" [ drop rotation-step 4D-Rxw rotation-4D ] + button* add-gadget + "XW -" [ drop rotation-step neg 4D-Rxw rotation-4D ] + button* add-gadget + @top-right grid-add + 1 >>fill + "YW +" [ drop rotation-step 4D-Ryw rotation-4D ] + button* add-gadget + "YW -" [ drop rotation-step neg 4D-Ryw rotation-4D ] + button* add-gadget + @right grid-add + 1 >>fill + "ZW +" [ drop rotation-step 4D-Rzw rotation-4D ] + button* add-gadget + "ZW -" [ drop rotation-step neg 4D-Rzw rotation-4D ] + button* add-gadget + @bottom-right grid-add +; + +: menu-translations-4D ( -- gadget ) + 3 3 + { 1 1 } >>filled-cell + 1 >>fill + 1 >>fill + "X+" [ drop { 1 0 0 0 } translation-step v*n + translation-4D ] + button* add-gadget + "X-" [ drop { -1 0 0 0 } translation-step v*n + translation-4D ] + button* add-gadget + add-gadget + "YZW" add-gadget + @bottom-right grid-add + 1 >>fill + "XZW" add-gadget + 1 >>fill + "Y+" [ drop { 0 1 0 0 } translation-step v*n + translation-4D ] + button* add-gadget + "Y-" [ drop { 0 -1 0 0 } translation-step v*n + translation-4D ] + button* add-gadget + add-gadget + @top-right grid-add + 1 >>fill + "XYW" add-gadget + 1 >>fill + "Z+" [ drop { 0 0 1 0 } translation-step v*n + translation-4D ] + button* add-gadget + "Z-" [ drop { 0 0 -1 0 } translation-step v*n + translation-4D ] + button* add-gadget + add-gadget + @top-left grid-add + 1 >>fill + 1 >>fill + "W+" [ drop { 0 0 0 1 } translation-step v*n + translation-4D ] + button* add-gadget + "W-" [ drop { 0 0 0 -1 } translation-step v*n + translation-4D ] + button* add-gadget + add-gadget + "XYZ" add-gadget + @bottom-left grid-add + "X" @center grid-add +; + +: menu-4D ( -- gadget ) + + "rotations" add-gadget + menu-rotations-4D add-gadget + "translations" add-gadget + menu-translations-4D add-gadget + 0.5 >>align + { 0 10 } >>gap +; + + +! ------------------------------------------------------ + +: redraw-model ( space -- ) + >present-space + update-model-projections + update-observer-projections ; + +: load-model-file ( -- ) + selected-file dup selected-file-model> set-model + read-model-file + redraw-model ; + +: mvt-3D-X ( turn pitch -- quot ) + '[ turtle-pos> norm neg reset-turtle + _ turn-left + _ pitch-up + step-turtle ] ; + +: mvt-3D-1 ( -- quot ) 90 0 mvt-3D-X ; inline +: mvt-3D-2 ( -- quot ) 0 90 mvt-3D-X ; inline +: mvt-3D-3 ( -- quot ) 0 0 mvt-3D-X ; inline +: mvt-3D-4 ( -- quot ) 45 45 mvt-3D-X ; inline + +: camera-button ( string quot -- button ) + [ ] dip camera-action ; + +! ---------------------------------------------------------- +! file chooser +! ---------------------------------------------------------- +: ( file-name -- button ) + dup '[ drop _ \ selected-file set-value load-model-file + ] + closed-quot { 0 0 } >>align ; + +: ( -- gadget ) + "resource:extra/4DNav" + 1 >>fill + over dup directory-files + [ ".xml" tail? ] filter + [ append-path ] with map + [ add-gadget ] each + swap ; + +! ----------------------------------------------------- + +: menu-rotations-3D ( -- gadget ) + 3 3 + { 1 1 } >>filled-cell + "Turn\n left" [ rotation-step turn-left ] + camera-button @left grid-add + "Turn\n right" [ rotation-step turn-right ] + camera-button @right grid-add + "Pitch down" [ rotation-step pitch-down ] + camera-button @bottom grid-add + "Pitch up" [ rotation-step pitch-up ] + camera-button @top grid-add + 1 >>fill + "Roll left\n (ctl)" [ rotation-step roll-left ] + camera-button add-gadget + "Roll right\n(ctl)" [ rotation-step roll-right ] + camera-button add-gadget + @center grid-add +; + +: menu-translations-3D ( -- gadget ) + 3 3 + { 1 1 } >>filled-cell + "left\n(alt)" [ translation-step strafe-left ] + camera-button @left grid-add + "right\n(alt)" [ translation-step strafe-right ] + camera-button @right grid-add + "Strafe up \n (alt)" [ translation-step strafe-up ] + camera-button @top grid-add + "Strafe down\n (alt)" [ translation-step strafe-down ] + camera-button @bottom grid-add + 1 >>fill + "Forward (ctl)" [ translation-step step-turtle ] + camera-button add-gadget + "Backward (ctl)" + [ translation-step neg step-turtle ] + camera-button add-gadget + @center grid-add +; + +: menu-quick-views ( -- gadget ) + + "View 1 (1)" mvt-3D-1 camera-button add-gadget + "View 2 (2)" mvt-3D-2 camera-button add-gadget + "View 3 (3)" mvt-3D-3 camera-button add-gadget + "View 4 (4)" mvt-3D-4 camera-button add-gadget +; + +: menu-3D ( -- gadget ) + + + menu-rotations-3D add-gadget + menu-translations-3D add-gadget + 0.5 >>align + { 0 10 } >>gap + add-gadget + menu-quick-views add-gadget ; + +TUPLE: handler < w:wrapper table ; + +: ( child -- handler ) handler w:new-wrapper ; + +M: handler handle-gesture ( gesture gadget -- ? ) + tuck table>> at dup [ call( gadget -- ) f ] [ 2drop t ] if ; + +: add-keyboard-delegate ( obj -- obj ) + +H{ + { T{ key-down f f "LEFT" } + [ [ rotation-step turn-left ] camera-action ] } + { T{ key-down f f "RIGHT" } + [ [ rotation-step turn-right ] camera-action ] } + { T{ key-down f f "UP" } + [ [ rotation-step pitch-down ] camera-action ] } + { T{ key-down f f "DOWN" } + [ [ rotation-step pitch-up ] camera-action ] } + + { T{ key-down f { C+ } "UP" } + [ [ translation-step step-turtle ] camera-action ] } + { T{ key-down f { C+ } "DOWN" } + [ [ translation-step neg step-turtle ] + camera-action ] } + { T{ key-down f { C+ } "LEFT" } + [ [ rotation-step roll-left ] camera-action ] } + { T{ key-down f { C+ } "RIGHT" } + [ [ rotation-step roll-right ] camera-action ] } + + { T{ key-down f { A+ } "LEFT" } + [ [ translation-step strafe-left ] camera-action ] } + { T{ key-down f { A+ } "RIGHT" } + [ [ translation-step strafe-right ] camera-action ] } + { T{ key-down f { A+ } "UP" } + [ [ translation-step strafe-up ] camera-action ] } + { T{ key-down f { A+ } "DOWN" } + [ [ translation-step strafe-down ] camera-action ] } + + + { T{ key-down f f "1" } [ mvt-3D-1 camera-action ] } + { T{ key-down f f "2" } [ mvt-3D-2 camera-action ] } + { T{ key-down f f "3" } [ mvt-3D-3 camera-action ] } + { T{ key-down f f "4" } [ mvt-3D-4 camera-action ] } + + } >>table + ; + +! -------------------------------------------- +! print elements +! -------------------------------------------- +! print-content + +GENERIC: adsoda-display-model ( x -- ) + +M: light adsoda-display-model +"\n light : " . + { + [ direction>> "direction : " pprint . ] + [ color>> "color : " pprint . ] + } cleave + ; + +M: face adsoda-display-model + { + [ halfspace>> "halfspace : " pprint . ] + [ touching-corners>> "touching corners : " pprint . ] + } cleave + ; +M: solid adsoda-display-model + { + [ name>> "solid called : " pprint . ] + [ color>> "color : " pprint . ] + [ dimension>> "dimension : " pprint . ] + [ faces>> "composed of faces : " pprint + [ adsoda-display-model ] each ] + } cleave + ; +M: space adsoda-display-model + { + [ dimension>> "dimension : " pprint . ] + [ ambient-color>> "ambient-color : " pprint . ] + [ solids>> "composed of solids : " pprint + [ adsoda-display-model ] each ] + [ lights>> "composed of lights : " pprint + [ adsoda-display-model ] each ] + } cleave + ; + +! ---------------------------------------------- +: menu-bar ( -- gadget ) + + "reinit" [ drop load-model-file ] button* add-gadget + selected-file-model> add-gadget + ; + + +: controller-window* ( -- gadget ) + { 0 1 } + menu-bar f track-add + + + f track-add + + "Projection mode : " add-gadget + model-projection-chooser add-gadget + f track-add + + "Collision detection (slow and buggy ) : " + add-gadget + collision-detection-chooser add-gadget + f track-add + + 0.5 >>align + menu-4D add-gadget + COLOR: purple s: >>interior + "4D movements" + f track-add + + 0.5 >>align + { 2 2 } >>gap + menu-3D add-gadget + COLOR: purple s: >>interior + "Camera 3D" + f track-add + COLOR: gray s: >>interior + ; + +: viewer-windows* ( -- ) + "YZW" view1> win3D + "XZW" view2> win3D + "XYW" view3> win3D + "XYZ" view4> win3D +; + +: navigator-window* ( -- ) + controller-window* + viewer-windows* + add-keyboard-delegate + "navigateur 4D" open-window +; + +: windows ( -- ) [ [ navigator-window* ] with-scope ] with-ui ; + + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init-variables ( -- ) + "choose a file" >selected-file-model + >observer3d + [ observer3d> >self + reset-turtle + 45 turn-left + 45 pitch-up + -300 step-turtle + ] with-scope + +; + + +: init-models ( -- ) + 0 model-projection observer3d> >view1 + 1 model-projection observer3d> >view2 + 2 model-projection observer3d> >view3 + 3 model-projection observer3d> >view4 +; + +: 4DNav ( -- ) + init-variables + selected-file read-model-file >present-space + init-models + windows +; + +MAIN: 4DNav + + diff --git a/4DNav/authors.txt b/4DNav/authors.txt new file mode 100644 index 0000000..6536f34 --- /dev/null +++ b/4DNav/authors.txt @@ -0,0 +1 @@ +Jeff Bigot diff --git a/4DNav/camera/authors.txt b/4DNav/camera/authors.txt new file mode 100644 index 0000000..bbc876e --- /dev/null +++ b/4DNav/camera/authors.txt @@ -0,0 +1 @@ +Adam Wendt diff --git a/4DNav/camera/camera-docs.factor b/4DNav/camera/camera-docs.factor new file mode 100644 index 0000000..65afafc --- /dev/null +++ b/4DNav/camera/camera-docs.factor @@ -0,0 +1,88 @@ +! Copyright (C) 2008 Jean-FranÃ§ois Bigot. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel ; +IN: 4DNav.camera + +HELP: camera-eye +{ $values + + { "point" "position" } +} +{ $description "return the position of the camera" } ; + +HELP: camera-focus +{ $values + + { "point" "position" } +} +{ $description "return the point the camera looks at" } ; + +HELP: camera-up +{ $values + + { "dirvec" "upside direction" } +} +{ $description "In order to precise the roling position of camera give an upward vector" } ; + +HELP: do-look-at +{ $values + { "camera" "direction" } +} +{ $description "Word to use in replacement of gl-look-at when using a camera" } ; + +ARTICLE: "4DNav.camera" "Camera" +{ $vocab-link "4DNav.camera" } +$nl +"A camera is defined by:" +{ $list +{ "a position (" { $link camera-eye } ")" } +{ "a focus direction (" { $link camera-focus } ")" } +{ "an attitude information (" { $link camera-up } ")" } +} +"Use " { $link do-look-at } " in opengl statement in placement of gl-look-at" +$nl +"A camera is a " { $vocab-link "4DNav.turtle" } " object. Its a special vocab to handle mouvements of a 3D object:" +{ $list +{ "To define a camera" +{ + $unchecked-example + +"VAR: my-camera" +": init-my-camera ( -- )" +" >my-camera" +" [ my-camera> >self" +" reset-turtle " +" ] with-scope ;" +} } +{ "To move it" +{ + $unchecked-example + +" [ my-camera> >self" +" 45 pitch-up " +" 5 step-turtle" +" ] with-scope " +} } +{ "or" +{ + $unchecked-example + +" [ my-camera> >self" +" 5 strafe-left" +" ] with-scope " +} +} +{ +"to use it in an opengl statement" +{ + $unchecked-example + "my-camera> do-look-at" + +} +} +} + + +; + +ABOUT: "4DNav.camera" diff --git a/4DNav/camera/camera.factor b/4DNav/camera/camera.factor new file mode 100644 index 0000000..0d46d73 --- /dev/null +++ b/4DNav/camera/camera.factor @@ -0,0 +1,18 @@ +USING: kernel namespaces math.vectors opengl opengl.glu 4DNav.turtle ; + +IN: 4DNav.camera + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: camera-eye ( -- point ) turtle-pos> ; + +: camera-focus ( -- point ) + [ 1 step-turtle turtle-pos> ] save-self ; + +: camera-up ( -- dirvec ) +[ 90 pitch-up turtle-pos> 1 step-turtle turtle-pos> swap v- ] + save-self ; + +: do-look-at ( camera -- ) +[ >self camera-eye camera-focus camera-up gl-look-at ] + with-scope ; diff --git a/4DNav/deep/deep-docs.factor b/4DNav/deep/deep-docs.factor new file mode 100644 index 0000000..78439c6 --- /dev/null +++ b/4DNav/deep/deep-docs.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2008 Jean-François Bigot. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations sequences ; +IN: 4DNav.deep + +! HELP: deep-cleave-quots +! { $values +! { "seq" sequence } +! { "quot" quotation } +! } +! { $description "A word to build a soquence from a sequence of quotation" } +! +! { $examples +! "It is useful to build matrix" +! { $example "USING: math math.trig ; " +! " 30 deg>rad " +! " { { [ cos ] [ sin neg ] 0 } " +! " { [ sin ] [ cos ] 0 } " +! " { 0 0 1 } " +! " } deep-cleave-quots " +! " " +! +! +! } } +! ; + +ARTICLE: "4DNav.deep" "Deep" +{ $vocab-link "4DNav.deep" } +; + +ABOUT: "4DNav.deep" diff --git a/4DNav/deep/deep.factor b/4DNav/deep/deep.factor new file mode 100644 index 0000000..f37bcf0 --- /dev/null +++ b/4DNav/deep/deep.factor @@ -0,0 +1,13 @@ +USING: macros quotations math math.functions math.trig +sequences.deep kernel make fry combinators grouping ; +IN: 4DNav.deep + +! USING: bake ; +! MACRO: deep-cleave-quots ( seq -- quot ) +! [ [ quotation? ] deep-filter ] +! [ [ dup quotation? [ drop , ] when ] deep-map ] +! bi '[ _ cleave _ bake ] ; + +: make-matrix ( quot width -- matrix ) + [ { } make ] dip group ; inline + diff --git a/4DNav/deploy.factor b/4DNav/deploy.factor new file mode 100644 index 0000000..44481f4 --- /dev/null +++ b/4DNav/deploy.factor @@ -0,0 +1,14 @@ +USING: tools.deploy.config ; +H{ + { deploy-c-types? t } + { deploy-word-props? t } + { deploy-name "4DNav" } + { deploy-ui? t } + { deploy-math? t } + { deploy-threads? t } + { deploy-reflection 3 } + { deploy-unicode? t } + { deploy-io 3 } + { "stop-after-last-window?" t } + { deploy-word-defs? t } +} diff --git a/4DNav/file-chooser/authors.txt b/4DNav/file-chooser/authors.txt new file mode 100644 index 0000000..6536f34 --- /dev/null +++ b/4DNav/file-chooser/authors.txt @@ -0,0 +1 @@ +Jeff Bigot diff --git a/4DNav/file-chooser/file-chooser.factor b/4DNav/file-chooser/file-chooser.factor new file mode 100644 index 0000000..c86ddbf --- /dev/null +++ b/4DNav/file-chooser/file-chooser.factor @@ -0,0 +1,154 @@ +! Copyright (C) 2008 Jeff Bigot +! See http://factorcode.org/license.txt for BSD license. +USING: +kernel +io.files +io.backend +io.directories +io.files.info +io.pathnames +sequences +models +strings +ui +ui.operations +ui.commands +ui.gestures +ui.gadgets +ui.gadgets.buttons +ui.gadgets.lists +ui.gadgets.labels +ui.gadgets.tracks +ui.gadgets.packs +ui.gadgets.panes +ui.gadgets.scrollers +prettyprint +combinators +accessors +values +tools.walker +fry +; +IN: 4DNav.file-chooser + +TUPLE: file-chooser < track + path + extension + selected-file + presenter + hook + list + ; + +: find-file-list ( gadget -- list ) + [ file-chooser? ] find-parent list>> ; + +file-chooser H{ + { T{ key-down f f "UP" } + [ find-file-list select-previous ] } + { T{ key-down f f "DOWN" } + [ find-file-list select-next ] } + { T{ key-down f f "PAGE_UP" } + [ find-file-list list-page-up ] } + { T{ key-down f f "PAGE_DOWN" } + [ find-file-list list-page-down ] } + { T{ key-down f f "RET" } + [ find-file-list invoke-value-action ] } + { T{ button-down } + request-focus } + { T{ button-down f 1 } + [ find-file-list invoke-value-action ] } +} set-gestures + +: list-of-files ( file-chooser -- seq ) + [ path>> value>> directory-entries ] [ extension>> ] bi + '[ [ name>> _ [ tail? ] with any? ] + [ directory? ] bi or ] filter +; + +: update-filelist-model ( file-chooser -- ) + [ list-of-files ] [ model>> ] bi set-model ; + +: init-filelist-model ( file-chooser -- file-chooser ) + dup list-of-files >>model ; + +: (fc-go) ( file-chooser button quot -- ) + [ [ file-chooser? ] find-parent dup path>> ] dip + call + normalize-path swap set-model + update-filelist-model + drop ; inline + +: fc-go-parent ( file-chooser button -- ) + [ dup value>> parent-directory ] (fc-go) ; + +: fc-go-home ( file-chooser button -- ) + [ home ] (fc-go) ; + +: fc-change-directory ( file-chooser file -- ) + dupd [ path>> value>> normalize-path ] [ name>> ] bi* + append-path over path>> set-model + update-filelist-model +; + +: fc-load-file ( file-chooser file -- ) + over [ name>> ] [ selected-file>> ] bi* set-model + [ [ path>> value>> ] [ selected-file>> value>> ] bi append ] [ hook>> ] bi + call( path -- ) +; inline + +! : fc-ok-action ( file-chooser -- quot ) +! dup selected-file>> value>> "" = +! [ drop [ drop ] ] [ +! [ path>> value>> ] +! [ selected-file>> value>> append ] +! [ hook>> prefix ] tri +! [ drop ] prepend +! ] if ; + +: line-selected-action ( file-chooser -- ) + dup list>> list-value + dup directory? + [ fc-change-directory ] [ fc-load-file ] if ; + +: present-dir-element ( element -- string ) + [ name>> ] [ directory? ] bi [ "-> " prepend ] when ; + +: ( file-chooser -- list ) + dup [ nip line-selected-action ] curry + [ present-dir-element ] rot model>> ; + +: ( hook path extension -- gadget ) + { 0 1 } file-chooser new-track + swap >>extension + swap >>path + "" >>selected-file + swap >>hook + init-filelist-model + dup >>list + "choose a file in directory " f track-add + dup path>> f track-add + dup extension>> ", " join "limited to : " prepend + f track-add + + "selected file : " add-gadget + over selected-file>> add-gadget + f track-add + + over [ swap fc-go-parent ] curry "go up" + swap add-gadget + over [ swap fc-go-home ] curry "go home" + swap add-gadget + ! over [ swap fc-ok-action ] curry "OK" + ! swap add-gadget + ! [ drop ] "Cancel" swap add-gadget + f track-add + dup list>> 1 track-add +; + +M: file-chooser pref-dim* drop { 400 200 } ; + +: file-chooser-window ( -- ) + [ . ] home { "xml" "txt" } + "Choose a file" open-window ; + diff --git a/4DNav/hypercube.xml b/4DNav/hypercube.xml new file mode 100644 index 0000000..0d46e3b --- /dev/null +++ b/4DNav/hypercube.xml @@ -0,0 +1,37 @@ + + + hypercube + 4 + + 4cube1 + 4 + 1,0,0,0,100 + -1,0,0,0,-150 + 0,1,0,0,100 + 0,-1,0,0,-150 + 0,0,1,0,100 + 0,0,-1,0,-150 + 0,0,0,1,100 + 0,0,0,-1,-150 + 1,0,0 + + + 4cube1 + 4 + 1,0,0,0,100 + -1,0,0,0,-150 + 0,1,0,0,100 + 0,-1,0,0,-150 + 0,0,1,0,100 + 0,0,-1,0,-150 + 0,0,0,1,100 + 0,0,0,-1,-150 + 1,0,0 + + + 1,1,1,1 + 0.2,0.2,0.6 + + 0.8,0.9,0.9 + + diff --git a/4DNav/light_test.xml b/4DNav/light_test.xml new file mode 100644 index 0000000..b7d750d --- /dev/null +++ b/4DNav/light_test.xml @@ -0,0 +1,62 @@ + + + multi solids + 4 + + 4cube1 + 4 + 1,0,0,0,100 + -1,0,0,0,-150 + 0,1,0,0,100 + 0,-1,0,0,-150 + 0,0,1,0,100 + 0,0,-1,0,-150 + 0,0,0,1,100 + 0,0,0,-1,-150 + 1,1,1 + + + 4triancube + 4 + 1,0,0,0,160 + -0.4999999999999998,-0.8660254037844387,0,0,-130 + -0.5000000000000004,0.8660254037844384,0,0,-130 + 0,0,1,0,140 + 0,0,-1,0,-180 + 0,0,0,1,110 + 0,0,0,-1,-180 + 1,1,1 + + + triangone + 4 + 1,0,0,0,60 + 0.5,0.8660254037844386,0,0,60 + -0.5,0.8660254037844387,0,0,-20 + -1.0,0,0,0,-100 + -0.5,-0.8660254037844384,0,0,-100 + 0.5,-0.8660254037844387,0,0,-20 + 0,0,1,0,120 + 0,0,-0.4999999999999998,-0.8660254037844387,-120 + 0,0,-0.5000000000000004,0.8660254037844384,-120 + 1,1,1 + + + 1,0,0,0 + 0,0,0,0.6 + + + 0,1,0,0 + 0,0.6,0,0 + + + 0,0,1,0 + 0,0,0.6,0 + + + 0,0,0,1 + 0.6,0.6,0.6 + + 0.99,0.99,0.99 + + diff --git a/4DNav/multi solids.xml b/4DNav/multi solids.xml new file mode 100644 index 0000000..b401e98 --- /dev/null +++ b/4DNav/multi solids.xml @@ -0,0 +1,50 @@ + + + multi solids + 4 + + 4cube1 + 4 + 1,0,0,0,100 + -1,0,0,0,-150 + 0,1,0,0,100 + 0,-1,0,0,-150 + 0,0,1,0,100 + 0,0,-1,0,-150 + 0,0,0,1,100 + 0,0,0,-1,-150 + 1,0,0 + + + 4triancube + 4 + 1,0,0,0,160 + -0.4999999999999998,-0.8660254037844387,0,0,-130 + -0.5000000000000004,0.8660254037844384,0,0,-130 + 0,0,1,0,140 + 0,0,-1,0,-180 + 0,0,0,1,110 + 0,0,0,-1,-180 + 0,1,0 + + + triangone + 4 + 1,0,0,0,60 + 0.5,0.8660254037844386,0,0,60 + -0.5,0.8660254037844387,0,0,-20 + -1.0,0,0,0,-100 + -0.5,-0.8660254037844384,0,0,-100 + 0.5,-0.8660254037844387,0,0,-20 + 0,0,1,0,120 + 0,0,-0.4999999999999998,-0.8660254037844387,-120 + 0,0,-0.5000000000000004,0.8660254037844384,-120 + 0,1,1 + + + 1,1,1,1 + 0.2,0.2,0.6 + + 0.8,0.9,0.9 + + diff --git a/4DNav/prismetriagone.xml b/4DNav/prismetriagone.xml new file mode 100644 index 0000000..cbdc071 --- /dev/null +++ b/4DNav/prismetriagone.xml @@ -0,0 +1,25 @@ + + + Prismetragone + 4 + + triangone + 4 + 1,0,0,0,60 + 0.5,0.8660254037844386,0,0,60 + -0.5,0.8660254037844387,0,0,-20 + -1.0,0,0,0,-100 + -0.5,-0.8660254037844384,0,0,-100 + 0.5,-0.8660254037844387,0,0,-20 + 0,0,1,0,120 + 0,0,-0.4999999999999998,-0.8660254037844387,-120 + 0,0,-0.5000000000000004,0.8660254037844384,-120 + 0,1,1 + + + 1,1,1,1 + 0.2,0.2,0.6 + + 0.8,0.9,0.9 + + diff --git a/4DNav/space-file-decoder/authors.txt b/4DNav/space-file-decoder/authors.txt new file mode 100644 index 0000000..6536f34 --- /dev/null +++ b/4DNav/space-file-decoder/authors.txt @@ -0,0 +1 @@ +Jeff Bigot diff --git a/4DNav/space-file-decoder/space-file-decoder-docs.factor b/4DNav/space-file-decoder/space-file-decoder-docs.factor new file mode 100644 index 0000000..0a78166 --- /dev/null +++ b/4DNav/space-file-decoder/space-file-decoder-docs.factor @@ -0,0 +1,20 @@ +! Copyright (C) 2008 Jean-FranÃ§ois Bigot. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel ; +IN: 4DNav.space-file-decoder + + + +HELP: read-model-file +{ $values + + { "path" "path to the file to read" } + { "x" "value" } +} +{ $description "Read a file containing the xml description of the model" } ; + +ARTICLE: "4DNav.space-file-decoder" "Space XMLfile decoder" +{ $vocab-link "4DNav.space-file-decoder" } +; + +ABOUT: "4DNav.space-file-decoder" diff --git a/4DNav/space-file-decoder/space-file-decoder.factor b/4DNav/space-file-decoder/space-file-decoder.factor new file mode 100644 index 0000000..92f39e2 --- /dev/null +++ b/4DNav/space-file-decoder/space-file-decoder.factor @@ -0,0 +1,64 @@ +! Copyright (C) 2008 Jeff Bigot +! See http://factorcode.org/license.txt for BSD license. +USING: adsoda xml xml.traversal xml.syntax accessors +combinators sequences math.parser kernel splitting values +continuations ; +IN: 4DNav.space-file-decoder + +: decode-number-array ( x -- y ) + "," split [ string>number ] map ; + +TAGS: adsoda-read-model ( tag -- model ) + +TAG: dimension adsoda-read-model + children>> first string>number ; +TAG: direction adsoda-read-model + children>> first decode-number-array ; +TAG: color adsoda-read-model + children>> first decode-number-array ; +TAG: name adsoda-read-model + children>> first ; +TAG: face adsoda-read-model + children>> first decode-number-array ; + +TAG: solid adsoda-read-model + swap + { + [ "dimension" tag-named adsoda-read-model >>dimension ] + [ "name" tag-named adsoda-read-model >>name ] + [ "color" tag-named adsoda-read-model >>color ] + [ "face" + tags-named [ adsoda-read-model cut-solid ] each ] + } cleave + ensure-adjacencies +; + +TAG: light adsoda-read-model + swap + { + [ "direction" tag-named adsoda-read-model >>direction ] + [ "color" tag-named adsoda-read-model >>color ] + } cleave +; + +TAG: space adsoda-read-model + swap + { + [ "dimension" tag-named adsoda-read-model >>dimension ] + [ "name" tag-named adsoda-read-model >>name ] + [ "color" tag-named + adsoda-read-model >>ambient-color ] + [ "solid" tags-named + [ adsoda-read-model suffix-solids ] each ] + [ "light" tags-named + [ adsoda-read-model suffix-lights ] each ] + } cleave +; + +: read-model-file ( path -- x ) + [ + [ file>xml "space" tag-named adsoda-read-model ] + [ 2drop ] recover + ] [ ] if* +; + diff --git a/4DNav/summary.txt b/4DNav/summary.txt new file mode 100644 index 0000000..2598a14 --- /dev/null +++ b/4DNav/summary.txt @@ -0,0 +1 @@ +Simple tool to navigate through a 4D space with projections on 4 3D spaces diff --git a/4DNav/tags.txt b/4DNav/tags.txt new file mode 100644 index 0000000..0c63a72 --- /dev/null +++ b/4DNav/tags.txt @@ -0,0 +1 @@ +4D viewer \ No newline at end of file diff --git a/4DNav/triancube.xml b/4DNav/triancube.xml new file mode 100644 index 0000000..8551bed --- /dev/null +++ b/4DNav/triancube.xml @@ -0,0 +1,23 @@ + + + triancube + 4 + + triancube + 4 + 1,0,0,0,160 + -0.4999999999999998,-0.8660254037844387,0,0,-130 + -0.5000000000000004,0.8660254037844384,0,0,-130 + 0,0,1,0,140 + 0,0,-1,0,-180 + 0,0,0,1,110 + 0,0,0,-1,-180 + 0,1,0 + + + 1,1,1,1 + 0.2,0.2,0.6 + + 0.8,0.9,0.9 + + diff --git a/4DNav/turtle/authors.txt b/4DNav/turtle/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/4DNav/turtle/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/4DNav/turtle/turtle-docs.factor b/4DNav/turtle/turtle-docs.factor new file mode 100644 index 0000000..b94ed99 --- /dev/null +++ b/4DNav/turtle/turtle-docs.factor @@ -0,0 +1,11 @@ +! Copyright (C) 2008 Jean-FranÃ§ois Bigot. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays help.markup help.syntax kernel sequences ; +IN: 4DNav.turtle + + +ARTICLE: "4DNav.turtle" "Turtle" +{ $vocab-link "4DNav.turtle" } +; + +ABOUT: "4DNav.turtle" diff --git a/4DNav/turtle/turtle.factor b/4DNav/turtle/turtle.factor new file mode 100644 index 0000000..4f89964 --- /dev/null +++ b/4DNav/turtle/turtle.factor @@ -0,0 +1,159 @@ +USING: kernel math arrays math.vectors math.matrices namespaces make +math.constants math.functions splitting grouping math.trig sequences +accessors 4DNav.deep models vars ; +IN: 4DNav.turtle + +! replacement of self + +VAR: self + +: with-self ( quot obj -- ) [ >self call ] with-scope ; inline + +: save-self ( quot -- ) self> [ self> clone >self call ] dip >self ; inline + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: turtle pos ori ; + +: ( -- turtle ) + turtle new + { 0 0 0 } clone >>pos + 3 identity-matrix >>ori +; + + +TUPLE: observer < turtle projection-mode collision-mode ; + +: ( -- object ) + observer new + 0 >>projection-mode + f >>collision-mode + ; + + +: turtle-pos> ( -- val ) self> pos>> ; +: >turtle-pos ( val -- ) self> pos<< ; + +: turtle-ori> ( -- val ) self> ori>> ; +: >turtle-ori ( val -- ) self> ori<< ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! These rotation matrices are from +! `Computer Graphics: Principles and Practice' + + +! waiting for deep-cleave-quots + +! : Rz ( angle -- Rx ) deg>rad +! { { [ cos ] [ sin neg ] 0 } +! { [ sin ] [ cos ] 0 } +! { 0 0 1 } +! } deep-cleave-quots ; + +! : Ry ( angle -- Ry ) deg>rad +! { { [ cos ] 0 [ sin ] } +! { 0 1 0 } +! { [ sin neg ] 0 [ cos ] } +! } deep-cleave-quots ; + +! : Rx ( angle -- Rz ) deg>rad +! { { 1 0 0 } +! { 0 [ cos ] [ sin neg ] } +! { 0 [ sin ] [ cos ] } +! } deep-cleave-quots ; + +: Rz ( angle -- Rx ) deg>rad +[ dup cos , dup sin neg , 0 , + dup sin , dup cos , 0 , + 0 , 0 , 1 , ] 3 make-matrix nip ; + +: Ry ( angle -- Ry ) deg>rad +[ dup cos , 0 , dup sin , + 0 , 1 , 0 , + dup sin neg , 0 , dup cos , ] 3 make-matrix nip ; + +: Rx ( angle -- Rz ) deg>rad +[ 1 , 0 , 0 , + 0 , dup cos , dup sin neg , + 0 , dup sin , dup cos , ] 3 make-matrix nip ; + + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: apply-rotation ( rotation -- ) + turtle-ori> swap m. >turtle-ori ; +: rotate-x ( angle -- ) Rx apply-rotation ; +: rotate-y ( angle -- ) Ry apply-rotation ; +: rotate-z ( angle -- ) Rz apply-rotation ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: pitch-up ( angle -- ) neg rotate-x ; +: pitch-down ( angle -- ) rotate-x ; + +: turn-left ( angle -- ) rotate-y ; +: turn-right ( angle -- ) neg rotate-y ; + +: roll-left ( angle -- ) neg rotate-z ; +: roll-right ( angle -- ) rotate-z ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! roll-until-horizontal +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: V ( -- V ) { 0 1 0 } ; + +: X ( -- 3array ) turtle-ori> [ first ] map ; +: Y ( -- 3array ) turtle-ori> [ second ] map ; +: Z ( -- 3array ) turtle-ori> [ third ] map ; + +: set-X ( seq -- ) turtle-ori> [ set-first ] 2each ; +: set-Y ( seq -- ) turtle-ori> [ set-second ] 2each ; +: set-Z ( seq -- ) turtle-ori> [ set-third ] 2each ; + +: roll-until-horizontal ( -- ) + V Z cross normalize set-X + Z X cross normalize set-Y ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: distance ( turtle turtle -- n ) + pos>> swap pos>> v- [ sq ] map-sum sqrt ; + +: move-by ( point -- ) turtle-pos> v+ >turtle-pos ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: reset-turtle ( -- ) + { 0 0 0 } clone >turtle-pos 3 identity-matrix >turtle-ori ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: step-vector ( length -- array ) { 0 0 1 } n*v ; + +: step-turtle ( length -- ) + step-vector turtle-ori> swap m.v + turtle-pos> v+ >turtle-pos ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: strafe-up ( length -- ) + 90 pitch-up + step-turtle + 90 pitch-down ; + +: strafe-down ( length -- ) + 90 pitch-down + step-turtle + 90 pitch-up ; + +: strafe-left ( length -- ) + 90 turn-left + step-turtle + 90 turn-right ; + +: strafe-right ( length -- ) + 90 turn-right + step-turtle + 90 turn-left ; diff --git a/4DNav/window3D/authors.txt b/4DNav/window3D/authors.txt new file mode 100644 index 0000000..6536f34 --- /dev/null +++ b/4DNav/window3D/authors.txt @@ -0,0 +1 @@ +Jeff Bigot diff --git a/4DNav/window3D/window3D-docs.factor b/4DNav/window3D/window3D-docs.factor new file mode 100644 index 0000000..a534d2e --- /dev/null +++ b/4DNav/window3D/window3D-docs.factor @@ -0,0 +1,12 @@ +! Copyright (C) 2008 Jean-FranÃ§ois Bigot. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel ; +IN: 4DNav.window3D + + + +ARTICLE: "4DNav.window3D" "Window3D" +{ $vocab-link "4DNav.window3D" } +; + +ABOUT: "4DNav.window3D" diff --git a/4DNav/window3D/window3D.factor b/4DNav/window3D/window3D.factor new file mode 100644 index 0000000..f995541 --- /dev/null +++ b/4DNav/window3D/window3D.factor @@ -0,0 +1,82 @@ +! Copyright (C) 2008 Jeff Bigot +! See http://factorcode.org/license.txt for BSD license. +USING: kernel +ui.gadgets +ui.render +opengl +opengl.gl +opengl.glu +4DNav.camera +4DNav.turtle +math +values +alien.c-types +accessors +namespaces +adsoda +models +prettyprint +; + +IN: 4DNav.window3D + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! drawing functions +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: window3D < gadget observer ; + +: ( model observer -- gadget ) + window3D new + swap 2dup + projection-mode>> add-connection + 2dup + collision-mode>> add-connection + >>observer + swap >>model + t >>root? +; + +M: window3D pref-dim* ( gadget -- dim ) drop { 300 300 } ; + +M: window3D draw-gadget* ( gadget -- ) + + GL_PROJECTION glMatrixMode + glLoadIdentity + 0.6 0.6 0.6 .9 glClearColor + dup observer>> projection-mode>> value>> 1 = + [ 60.0 1.0 0.1 3000.0 gluPerspective ] + [ -400.0 400.0 -400.0 400.0 0.0 4000.0 glOrtho ] if + dup observer>> collision-mode>> value>> + \ remove-hidden-solids? + set-value + dup observer>> do-look-at + GL_MODELVIEW glMatrixMode + glLoadIdentity + 0.9 0.9 0.9 1.0 glClearColor + 1.0 glClearDepth + GL_LINE_SMOOTH glEnable + GL_BLEND glEnable + GL_DEPTH_TEST glEnable + GL_LEQUAL glDepthFunc + GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc + GL_LINE_SMOOTH_HINT GL_NICEST glHint + 1.25 glLineWidth + GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor + glClear + glLoadIdentity + GL_LIGHTING glEnable + GL_LIGHT0 glEnable + GL_COLOR_MATERIAL glEnable + GL_FRONT GL_AMBIENT_AND_DIFFUSE glColorMaterial + ! ************************* + + control-value + [ space->GL ] when* + + ! ************************* +; + +M: window3D graft* drop ; + +M: window3D model-changed nip relayout ; diff --git a/L-system/L-system.factor b/L-system/L-system.factor new file mode 100644 index 0000000..cc91042 --- /dev/null +++ b/L-system/L-system.factor @@ -0,0 +1,511 @@ + +USING: accessors arrays assocs calendar colors +combinators.short-circuit help.markup help.syntax kernel locals +math math.functions math.matrices math.order math.parser +math.trig math.vectors opengl opengl.demo-support opengl.gl +sbufs sequences strings threads ui.gadgets ui.gadgets.worlds +ui.gestures ui.render ui.tools.workspace ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +IN: L-system + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: pos ori angle length thickness color vertices saved ; + +DEFER: default-L-parser-values + +: reset-turtle ( turtle -- turtle ) + { 0 0 0 } clone >>pos + 3 identity-matrix >>ori + V{ } clone >>vertices + V{ } clone >>saved + + default-L-parser-values ; + +: turtle ( -- turtle ) new reset-turtle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: step-turtle ( TURTLE LENGTH -- turtle ) + + TURTLE + TURTLE pos>> TURTLE ori>> { 0 0 LENGTH } m.v v+ + >>pos ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: Rx ( ANGLE -- Rx ) + + [let | ANGLE [ ANGLE deg>rad ] | + + [let | A [ ANGLE cos ] + B [ ANGLE sin neg ] + C [ ANGLE sin ] + D [ ANGLE cos ] | + + { { 1 0 0 } + { 0 A B } + { 0 C D } } + + ] ] ; + +:: Ry ( ANGLE -- Ry ) + + [let | ANGLE [ ANGLE deg>rad ] | + + [let | A [ ANGLE cos ] + B [ ANGLE sin ] + C [ ANGLE sin neg ] + D [ ANGLE cos ] | + + { { A 0 B } + { 0 1 0 } + { C 0 D } } + + ] ] ; + +:: Rz ( ANGLE -- Rz ) + + [let | ANGLE [ ANGLE deg>rad ] | + + [let | A [ ANGLE cos ] + B [ ANGLE sin neg ] + C [ ANGLE sin ] + D [ ANGLE cos ] | + + { { A B 0 } + { C D 0 } + { 0 0 1 } } + + ] ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: apply-rotation ( TURTLE ROTATION -- turtle ) + + TURTLE TURTLE ori>> ROTATION m. >>ori ; + +: rotate-x ( turtle angle -- turtle ) Rx apply-rotation ; +: rotate-y ( turtle angle -- turtle ) Ry apply-rotation ; +: rotate-z ( turtle angle -- turtle ) Rz apply-rotation ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: pitch-up ( turtle angle -- turtle ) neg rotate-x ; +: pitch-down ( turtle angle -- turtle ) rotate-x ; + +: turn-left ( turtle angle -- turtle ) rotate-y ; +: turn-right ( turtle angle -- turtle ) neg rotate-y ; + +: roll-left ( turtle angle -- turtle ) neg rotate-z ; +: roll-right ( turtle angle -- turtle ) rotate-z ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: V ( -- V ) { 0 1 0 } ; + +: X ( turtle -- 3array ) ori>> [ first ] map ; +: Y ( turtle -- 3array ) ori>> [ second ] map ; +: Z ( turtle -- 3array ) ori>> [ third ] map ; + +: set-X ( turtle seq -- turtle ) over ori>> [ set-first ] 2each ; +: set-Y ( turtle seq -- turtle ) over ori>> [ set-second ] 2each ; +: set-Z ( turtle seq -- turtle ) over ori>> [ set-third ] 2each ; + +:: roll-until-horizontal ( TURTLE -- turtle ) + + TURTLE + + V TURTLE Z cross normalize set-X + + TURTLE Z TURTLE X cross normalize set-Y ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: strafe-up ( TURTLE LENGTH -- turtle ) + TURTLE 90 pitch-up LENGTH step-turtle 90 pitch-down ; + +:: strafe-down ( TURTLE LENGTH -- turtle ) + TURTLE 90 pitch-down LENGTH step-turtle 90 pitch-up ; + +:: strafe-left ( TURTLE LENGTH -- turtle ) + TURTLE 90 turn-left LENGTH step-turtle 90 turn-right ; + +:: strafe-right ( TURTLE LENGTH -- turtle ) + TURTLE 90 turn-right LENGTH step-turtle 90 turn-left ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: polygon ( vertices -- ) GL_POLYGON glBegin [ first3 glVertex3d ] each glEnd ; + +: start-polygon ( turtle -- turtle ) dup vertices>> delete-all ; + +: finish-polygon ( turtle -- turtle ) dup vertices>> polygon ; + +: polygon-vertex ( turtle -- turtle ) dup [ pos>> ] [ vertices>> ] bi push ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: record-vertex ( turtle -- turtle ) dup pos>> first3 glVertex3d ; + +: draw-forward ( turtle length -- turtle ) + GL_LINES glBegin [ record-vertex ] dip step-turtle record-vertex glEnd ; + +: move-forward ( turtle length -- turtle ) step-turtle polygon-vertex ; + +: sneak-forward ( turtle length -- turtle ) step-turtle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: scale-length ( turtle m -- turtle ) over length>> * >>length ; +: scale-angle ( turtle m -- turtle ) over angle>> * >>angle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: set-thickness ( turtle i -- turtle ) dup glLineWidth >>thickness ; + +: scale-thickness ( turtle m -- turtle ) + over thickness>> * 0.5 max set-thickness ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: color-table ( -- colors ) + { + T{ rgba f 0 0 0 1 } ! black + T{ rgba f 0.5 0.5 0.5 1 } ! grey + T{ rgba f 1 0 0 1 } ! red + T{ rgba f 1 1 0 1 } ! yellow + T{ rgba f 0 1 0 1 } ! green + T{ rgba f 0.25 0.88 0.82 1 } ! turquoise + T{ rgba f 0 0 1 1 } ! blue + T{ rgba f 0.63 0.13 0.94 1 } ! purple + T{ rgba f 0.00 0.50 0.00 1 } ! dark green + T{ rgba f 0.00 0.82 0.82 1 } ! dark turquoise + T{ rgba f 0.00 0.00 0.50 1 } ! dark blue + T{ rgba f 0.58 0.00 0.82 1 } ! dark purple + T{ rgba f 0.50 0.00 0.00 1 } ! dark red + T{ rgba f 0.25 0.25 0.25 1 } ! dark grey + T{ rgba f 0.75 0.75 0.75 1 } ! medium grey + T{ rgba f 1 1 1 1 } ! white + } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! : material-color ( color -- ) +! GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE rot gl-material ; + +: material-color ( color -- ) + GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE rot color>raw 4array gl-material ; + +: set-color ( turtle i -- turtle ) + dup color-table nth dup gl-color material-color >>color ; + +: inc-color ( turtle -- turtle ) dup color>> 1 + set-color ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: save-turtle ( turtle -- turtle ) dup clone over saved>> push ; + +: restore-turtle ( turtle -- turtle ) saved>> pop dup color>> set-color ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: default-L-parser-values ( turtle -- turtle ) + 1 >>length 45 >>angle 1 >>thickness 2 >>color ; + +: L-parser-dialect ( -- commands ) + + { + { "+" [ dup angle>> turn-left ] } + { "-" [ dup angle>> turn-right ] } + { "&" [ dup angle>> pitch-down ] } + { "^" [ dup angle>> pitch-up ] } + { "<" [ dup angle>> roll-left ] } + { ">" [ dup angle>> roll-right ] } + + { "|" [ 180.0 rotate-y ] } + { "%" [ 180.0 rotate-z ] } + { "$" [ roll-until-horizontal ] } + + { "F" [ dup length>> draw-forward ] } + { "Z" [ dup length>> 2 / draw-forward ] } + { "f" [ dup length>> move-forward ] } + { "z" [ dup length>> 2 / move-forward ] } + { "g" [ dup length>> sneak-forward ] } + { "." [ polygon-vertex ] } + + { "[" [ save-turtle ] } + { "]" [ restore-turtle ] } + + { "{" [ start-polygon ] } + { "}" [ finish-polygon ] } + + { "/" [ 1.1 scale-length ] } ! double quote command in lparser + { "'" [ 0.9 scale-length ] } + { ";" [ 1.1 scale-angle ] } + { ":" [ 0.9 scale-angle ] } + { "?" [ 1.4 scale-thickness ] } + { "!" [ 0.7 scale-thickness ] } + + { "c" [ dup color>> 1 + color-table length mod set-color ] } + + } + ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < gadget + camera display-list pedestal paused + turtle-values + commands axiom rules string ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: iterate-system ( GADGET -- ) GADGET pedestal>> 0.5 + GADGET pedestal<< ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: start-rotation-thread ( GADGET -- ) + GADGET f >>paused drop + [ + [ + GADGET paused>> + [ f ] + [ GADGET iterate-system GADGET relayout-1 25 milliseconds sleep t ] + if + ] + loop + ] + in-thread ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: open-paren ( -- ch ) CHAR: ( ; +: close-paren ( -- ch ) CHAR: ) ; + +: open-paren? ( obj -- ? ) open-paren = ; +: close-paren? ( obj -- ? ) close-paren = ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: read-instruction ( STRING -- next rest ) + + { [ STRING length 1 > ] [ STRING second open-paren? ] } 0&& + [ STRING close-paren STRING index 1 + cut ] + [ STRING 1 cut ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: iterate-string-loop ( STRING RULES ACCUM -- ) + STRING empty? not + [ + STRING read-instruction + + [let | REST [ ] NEXT [ ] | + + NEXT 1 head RULES at NEXT or ACCUM push-all + + REST RULES ACCUM iterate-string-loop ] + ] + when ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: iterate-string ( STRING RULES -- string ) + + [let | ACCUM [ STRING length 10 * ] | + + STRING RULES ACCUM iterate-string-loop + + ACCUM >string ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: interpret-string ( STRING COMMANDS -- ) + + STRING empty? not + [ + STRING read-instruction + + [let | REST [ ] NEXT [ ] | + + [let | COMMAND [ NEXT 1 head COMMANDS at ] | + + COMMAND + [ + NEXT length 1 = + [ COMMAND call ] + [ + NEXT 2 tail 1 head* string>number + COMMAND 1 tail* + call + ] + if + ] + when ] + + REST COMMANDS interpret-string ] + ] + when ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: iterate-L-system-string ( L-SYSTEM -- ) + L-SYSTEM string>> L-SYSTEM axiom>> or + L-SYSTEM rules>> + iterate-string + L-SYSTEM string<< ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: do-camera-look-at ( CAMERA -- ) + + [let | EYE [ CAMERA pos>> ] + FOCUS [ CAMERA clone 1 step-turtle pos>> ] + UP [ CAMERA clone 90 pitch-up 1 step-turtle pos>> CAMERA pos>> v- ] + | + + EYE FOCUS UP gl-look-at ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: generate-display-list ( L-SYSTEM -- ) + + L-SYSTEM find-gl-context + + L-SYSTEM display-list>> GL_COMPILE glNewList + + turtle + L-SYSTEM turtle-values>> [ ] or call + L-SYSTEM string>> L-SYSTEM axiom>> or + L-SYSTEM commands>> + interpret-string + drop + + glEndList ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M:: draw-gadget* ( L-SYSTEM -- ) + + black gl-clear + + GL_FLAT glShadeModel + + GL_PROJECTION glMatrixMode + glLoadIdentity + -1 1 -1 1 1.5 200 glFrustum + + GL_MODELVIEW glMatrixMode + + glLoadIdentity + + L-SYSTEM camera>> do-camera-look-at + + GL_FRONT_AND_BACK GL_LINE glPolygonMode + + ! draw axis + white gl-color GL_LINES glBegin { 0 0 0 } gl-vertex { 0 0 1 } gl-vertex glEnd + + ! rotate pedestal + + L-SYSTEM pedestal>> 0 0 1 glRotated + + L-SYSTEM display-list>> glCallList ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M:: graft* ( L-SYSTEM -- ) + + L-SYSTEM find-gl-context + + 1 glGenLists L-SYSTEM display-list<< ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M:: pref-dim* ( L-SYSTEM -- dim ) { 400 400 } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: with-camera ( L-SYSTEM QUOT -- ) + L-SYSTEM camera>> QUOT call drop + L-SYSTEM relayout-1 ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +H{ + { T{ key-down f f "LEFT" } [ [ 5 turn-left ] with-camera ] } + { T{ key-down f f "RIGHT" } [ [ 5 turn-right ] with-camera ] } + { T{ key-down f f "UP" } [ [ 5 pitch-down ] with-camera ] } + { T{ key-down f f "DOWN" } [ [ 5 pitch-up ] with-camera ] } + + { T{ key-down f f "a" } [ [ 1 step-turtle ] with-camera ] } + { T{ key-down f f "z" } [ [ -1 step-turtle ] with-camera ] } + + { T{ key-down f f "q" } [ [ 5 roll-left ] with-camera ] } + { T{ key-down f f "w" } [ [ 5 roll-right ] with-camera ] } + + { T{ key-down f { A+ } "LEFT" } [ [ 1 strafe-left ] with-camera ] } + { T{ key-down f { A+ } "RIGHT" } [ [ 1 strafe-right ] with-camera ] } + { T{ key-down f { A+ } "UP" } [ [ 1 strafe-up ] with-camera ] } + { T{ key-down f { A+ } "DOWN" } [ [ 1 strafe-down ] with-camera ] } + + { T{ key-down f f "r" } [ start-rotation-thread ] } + + { + T{ key-down f f "x" } + [ + dup iterate-L-system-string + dup generate-display-list + dup relayout-1 + drop + ] + } + + { T{ key-down f f "F1" } [ drop "L-system" help-window ] } + +} +set-gestures + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: L-system ( -- L-system ) + + new-gadget + + 0 >>pedestal + + ! turtle 45 turn-left 45 pitch-up 5 step-turtle 180 turn-left >>camera ; + + turtle 90 pitch-down -5 step-turtle 2 strafe-up >>camera + + dup start-rotation-thread + + ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +ARTICLE: "L-system" "L-system" + +"Press 'x' to iterate the L-system." $nl + +"Camera control:" + +{ $table + + { "a" "Forward" } + { "z" "Backward" } + + { "LEFT" "Turn left" } + { "RIGHT" "Turn right" } + { "UP" "Pitch down" } + { "DOWN" "Pitch up" } + + { "q" "Roll left" } + { "w" "Roll right" } } ; + +ABOUT: "L-system" diff --git a/L-system/models/abop-1/abop-1.factor b/L-system/models/abop-1/abop-1.factor new file mode 100644 index 0000000..34f1d47 --- /dev/null +++ b/L-system/models/abop-1/abop-1.factor @@ -0,0 +1,27 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-1 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-1 ( -- ) + + L-parser-dialect >>commands + + "c(12)FFAL" >>axiom + + { + { "A" "F [ & '(.8) ! B L ] >(137) ' !(.9) A" } + { "B" "F [ - '(.8) !(.9) $ C L ] ' !(.9) C" } + { "C" "F [ + '(.8) !(.9) $ B L ] ' !(.9) B" } + + { "L" " ~ c(8) { +(30) f -(120) f -(120) f }" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-1 "L-system" open-window ] with-ui ; + +MAIN: main diff --git a/L-system/models/abop-2/abop-2.factor b/L-system/models/abop-2/abop-2.factor new file mode 100644 index 0000000..1168780 --- /dev/null +++ b/L-system/models/abop-2/abop-2.factor @@ -0,0 +1,31 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-2 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-2 ( -- ) + + L-parser-dialect >>commands + + [ 30 >>angle ] >>turtle-values + + "c(12)FAL" >>axiom + + { + { "A" "F [&'(.7)!BL] >(137) [&'(.6)!BL] >(137) '(.9) !(.9) A" } + + { "B" "F [- '(.7) !(.9) $ C L] '(.9) !(.9) C" } + { "C" "F [+ '(.7) !(.9) $ B L] '(.9) !(.9) B" } + + { "L" "~c(8){+f(.1)-f(.1)-f(.1)+|+f(.1)-f(.1)-f(.1)}" } + + } >>rules ; + + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-2 "L-system" open-window ] with-ui ; + +MAIN: main diff --git a/L-system/models/abop-3/abop-3.factor b/L-system/models/abop-3/abop-3.factor new file mode 100644 index 0000000..f594caf --- /dev/null +++ b/L-system/models/abop-3/abop-3.factor @@ -0,0 +1,27 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-3 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-3 ( -- ) + + L-parser-dialect >>commands + + [ 30 >>angle ] >>turtle-values + + "c(12)FA" >>axiom + + { + { "A" "!(.9)t(.4)FB>(94)B>(132)B" } + { "B" "[&t(.4)F$A]" } + { "F" "'(1.25)F'(.8)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-3 "L-system" open-window ] with-ui ; + +MAIN: main diff --git a/L-system/models/abop-4/abop-4.factor b/L-system/models/abop-4/abop-4.factor new file mode 100644 index 0000000..71cf32d --- /dev/null +++ b/L-system/models/abop-4/abop-4.factor @@ -0,0 +1,56 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-4 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-4 ( -- ) + + L-parser-dialect >>commands + + [ 18 >>angle ] >>turtle-values + + "c(12)&(20)N" >>axiom + + { + { + "N" + "FII[&(60)rY]>(90)[&(45)'(0.8)rA]>(90)[&(60)rY]>(90)[&(45)'(0.8)rD]!FIK" + } + { "Y" "[c(4){++l.--l.--l.++|++l.--l.--l.}]" } + { "l" "g(.2)l" } + { "K" "[!c(2)FF>w>(72)w>(72)w>(72)w>(72)w]" } + { "w" "[c(2)^!F][c(5)&(72){-(54)f(3)+(54)f(3)|-(54)f(3)+(54)f(3)}]" } + { "f" "_" } + + { "A" "B" } + { "B" "C" } + { "C" "D" } + { "D" "E" } + { "E" "G" } + { "G" "H" } + { "H" "N" } + + { "I" "FoO" } + { "O" "FoP" } + { "P" "FoQ" } + { "Q" "FoR" } + { "R" "FoS" } + { "S" "FoT" } + { "T" "FoU" } + { "U" "FoV" } + { "V" "FoW" } + { "W" "FoX" } + { "X" "_" } + + { "o" "$t(-0.03)" } + { "r" "~(30)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-4 "L-system" open-window ] with-ui ; + +MAIN: main diff --git a/L-system/models/abop-5-angular/abop-5-angular.factor b/L-system/models/abop-5-angular/abop-5-angular.factor new file mode 100644 index 0000000..9e78258 --- /dev/null +++ b/L-system/models/abop-5-angular/abop-5-angular.factor @@ -0,0 +1,33 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-5-angular + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-5-angular ( -- ) + + L-parser-dialect >>commands + + "&(90)+(90)a" >>axiom + + { + { "a" "F[+(45)l][-(45)l]^;ca" } + + { "l" "j" } + { "j" "h" } + { "h" "s" } + { "s" "d" } + { "d" "x" } + { "x" "a" } + + { "F" "'(1.17)F'(.855)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-5-angular "L-system" open-window ] with-ui ; + +MAIN: main + diff --git a/L-system/models/abop-5/abop-5.factor b/L-system/models/abop-5/abop-5.factor new file mode 100644 index 0000000..73dc13d --- /dev/null +++ b/L-system/models/abop-5/abop-5.factor @@ -0,0 +1,35 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-5 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-5 ( -- ) + + L-parser-dialect >>commands + + [ 5 >>angle ] >>turtle-values + + "a" >>axiom + + { + { "a" "F[+(45)l][-(45)l]^;ca" } + + { "l" "j" } + { "j" "h" } + { "h" "s" } + { "s" "d" } + { "d" "x" } + { "x" "a" } + + { "F" "'(1.17)F'(.855)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-5 "L-system" open-window ] with-ui ; + +MAIN: main + diff --git a/L-system/models/abop-6/abop-6.factor b/L-system/models/abop-6/abop-6.factor new file mode 100644 index 0000000..79680bd --- /dev/null +++ b/L-system/models/abop-6/abop-6.factor @@ -0,0 +1,34 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.abop-6 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: abop-6 ( -- ) + + L-parser-dialect >>commands + + [ 5 >>angle ] >>turtle-values + + ! "&(90)+(90)FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x" + "FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x" + >>axiom + + { + { "a" "F[cdx][cex]F!(.9)a" } + { "x" "a" } + + { "d" "+d" } + { "e" "-e" } + + { "F" "'(1.25)F'(.8)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system abop-6 "L-system" open-window ] with-ui ; + +MAIN: main + diff --git a/L-system/models/airhorse/airhorse.factor b/L-system/models/airhorse/airhorse.factor new file mode 100644 index 0000000..07f4224 --- /dev/null +++ b/L-system/models/airhorse/airhorse.factor @@ -0,0 +1,52 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.airhorse + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: airhorse ( -- ) + + L-parser-dialect >>commands + + [ 10 >>angle ] >>turtle-values + + "C" >>axiom + + { + { "C" "LBW" } + + { "B" "[[''aH]|[g]]" } + { "a" "Fs+;'a" } + { "g" "Ft+;'g" } + { "s" "[::cc!!!!&&[FFcccZ]^^^^FFcccZ]" } + { "t" "[c!!!!&[FF]^^FF]" } + + { "L" "O" } + { "O" "P" } + { "P" "Q" } + { "Q" "R" } + { "R" "U" } + { "U" "X" } + { "X" "Y" } + { "Y" "V" } + { "V" "[cc!!!&(90)[Zp]|[Zp]]" } + { "p" "h>(120)h>(120)h" } + { "h" "[+(40)!F'''p]" } + + { "H" "[cccci[>(50)dcFFF][<(50)ecFFF]]" } + { "d" "Z!&Z!&:'d" } + { "e" "Z!^Z!^:'e" } + { "i" "-:/i" } + + { "W" "[%[!!cb][<<>>!!cb]]" } + { "b" "Fl!+Fl+;'b" } + { "l" "[-cc{--z++z++z--|--z++z++z}]" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system airhorse "L-system" open-window ] with-ui ; + +MAIN: main diff --git a/L-system/models/tree-5/tree-5.factor b/L-system/models/tree-5/tree-5.factor new file mode 100644 index 0000000..d4026ef --- /dev/null +++ b/L-system/models/tree-5/tree-5.factor @@ -0,0 +1,36 @@ + +USING: accessors ui L-system ; + +IN: L-system.models.tree-5 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: tree-5 ( -- ) + + L-parser-dialect >>commands + + [ 5 >>angle ] >>turtle-values + + "c(4)FFS" >>axiom + + { + { "S" "FFR>(60)R>(60)R>(60)R>(60)R>(60)R>(30)S" } + { "R" "[Ba]" } + { "a" "$tF[Cx]Fb" } + { "b" "$tF[Dy]Fa" } + { "B" "&B" } + { "C" "+C" } + { "D" "-D" } + + { "x" "a" } + { "y" "b" } + + { "F" "'(1.25)F'(.8)" } + } + >>rules ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: main ( -- ) [ L-system tree-5 "L-system" open-window ] with-ui ; + +MAIN: main diff --git a/LICENSE b/LICENSE index 533cdba..e9cd58a 100644 --- a/LICENSE +++ b/LICENSE @@ -1,29 +1,20 @@ -BSD 3-Clause License - -Copyright (c) 2017, Factor - A Practical Stack Language -All rights reserved. - Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -* Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. - -* Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. +1. Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. -* Neither the name of the copyright holder nor the names of its - contributors may be used to endorse or promote products derived from - this software without specific prior written permission. +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/adsoda/adsoda-docs.factor b/adsoda/adsoda-docs.factor new file mode 100644 index 0000000..a6ad0c7 --- /dev/null +++ b/adsoda/adsoda-docs.factor @@ -0,0 +1,307 @@ +! Copyright (C) 2008 Jeff Bigot +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax ; +IN: adsoda + +! -------------------------------------------------------------- +! faces +! -------------------------------------------------------------- +ARTICLE: "face-page" "Face in ADSODA" +"explanation of faces" +$nl +"link to functions" $nl +"what is an halfspace" $nl +"halfspace touching-corners adjacent-faces" $nl +"touching-corners list of pointers to the corners which touch this face" $nl +"adjacent-faces list of pointers to the faces which touch this face" +{ $subsections + face + +} +"test relative position" +{ $subsections + point-inside-or-on-face? + point-inside-face? +} +"handling face" +{ $subsections + flip-face + face-translate + face-transform +} + +; + +HELP: face +{ $class-description "a face is defined by" +{ $list "halfspace equation" } +{ $list "list of touching corners" } +{ $list "list of adjacent faces" } +$nl +"Touching corners and adjacent faces are defined by algorithm thanks to other faces of the solid" +} + + +; +HELP: +{ $values { "v" "an halfspace equation" } { "tuple" "a face" } } ; +HELP: flip-face +{ $values { "face" "a face" } { "face" "flipped face" } } +{ $description "change the orientation of a face" } +; + +HELP: face-translate +{ $values { "face" "a face" } { "v" "a vector" } } +{ $description +"translate a face following a vector" +$nl +"a translation of an halfspace doesn't change the normal vector. this word just compute the new constant term" } + + + ; +HELP: face-transform +{ $values { "face" "a face" } { "m" "a transformation matrix" } } +{ $description "compute the transformation of a face using a transformation matrix" } + + ; +! -------------------------------- +! solid +! -------------------------------------------------------------- +ARTICLE: "solid-page" "Solid in ADSODA" +"explanation of solids" +$nl +"link to functions" +{ $subsections + solid + +} +"test relative position" +{ $subsections + point-inside-solid? + point-inside-or-on-solid? +} +"playing with faces and solids" +{ $subsections + add-face + cut-solid + slice-solid +} +"solid handling" +{ $subsections + solid-project + solid-translate + solid-transform + subtract + get-silhouette + solid= +} +; + +HELP: solid +{ $class-description "dimension" $nl "silhouettes" $nl "faces" $nl "corners" $nl "adjacencies-valid" $nl "color" $nl "name" +} +; + +HELP: add-face +{ $values { "solid" "a solid" } { "face" "a face" } } +{ $description "reshape a solid with a face. The face truncate the solid." } ; + +HELP: cut-solid +{ $values { "solid" "a solid" } { "halfspace" "an halfspace" } } +{ $description "like add-face but just with halfspace equation" } ; + +HELP: slice-solid +{ $values { "solid" "a solid" } { "face" "a face" } { "solid1" "the outer part of the former solid" } { "solid2" "the inner part of the former solid" } } +{ $description "cut a solid into two parts. The face acts like a knife" +} ; + + +HELP: solid-project +{ $values { "lights" "lights" } { "ambient" "ambient" } { "solid" "solid" } { "solids" "projection of solid" } } +{ $description "Project the solid using pv vector" +$nl +"TODO: explain how to use lights" +} ; + +HELP: solid-translate +{ $values { "solid" "a solid" } { "v" "translating vector" } } +{ $description "Translate a solid using a vector" +$nl +"v and solid must have the same dimension " +} ; + +HELP: solid-transform +{ $values { "solid" "a solid" } { "m" "transformation matrix" } } +{ $description "Transform a solid using a matrix" +$nl +"v and solid must have the same dimension " +} ; + +HELP: subtract +{ $values { "solid1" "initial shape" } { "solid2" "shape to remove" } { "solids" "resulting shape" } } +{ $description "Substract solid2 from solid1" } ; + + +! -------------------------------------------------------------- +! space +! -------------------------------------------------------------- +ARTICLE: "space-page" "Space in ADSODA" +"A space is a collection of solids and lights." +$nl +"link to functions" +$nl +"Defining words" +{ $subsections + space + + suffix-solids + suffix-lights + clear-space-solids + describe-space +} + + +"Handling space" +{ $subsections + space-ensure-solids + eliminate-empty-solids + space-transform + space-translate + remove-hidden-solids + space-project +} + + +; + +HELP: space +{ $class-description +"dimension" $nl " solids" $nl " ambient-color" $nl "lights" +} +; + +HELP: suffix-solids +"( space solid -- space )" +{ $values { "space" "a space" } { "solid" "a solid to add" } } +{ $description "Add solid to space definition" } ; + +HELP: suffix-lights +"( space light -- space ) " +{ $values { "space" "a space" } { "light" "a light to add" } } +{ $description "Add a light to space definition" } ; + +HELP: clear-space-solids +"( space -- space )" +{ $values { "space" "a space" } } +{ $description "remove all solids in space" } ; + +HELP: space-ensure-solids +{ $values { "space" "a space" } } +{ $description "rebuild corners of all solids in space" } ; + + + +HELP: space-transform +{ $values { "space" "a space" } { "m" "a matrix" } } +{ $description "Transform a space using a matrix" } ; + +HELP: space-translate +{ $values { "space" "a space" } { "v" "a vector" } } +{ $description "Translate a space following a vector" } ; + +HELP: describe-space +{ $values { "space" "a space" } } +{ $description "return a description of space" } ; + +HELP: space-project +{ $values { "space" "a space" } { "i" "an integer" } } +{ $description "Project a space along ith coordinate" } ; + +! -------------------------------------------------------------- +! 3D rendering +! -------------------------------------------------------------- +ARTICLE: "3D-rendering-page" "The 3D rendering in ADSODA" +"explanation of 3D rendering" +$nl +"link to functions" +{ $subsections + face->GL + solid->GL + space->GL +} + +; + +HELP: face->GL +{ $values { "face" "a face" } { "color" "3 3 values array" } } +{ $description "display a face" } ; + +HELP: solid->GL +{ $values { "solid" "a solid" } } +{ $description "display a solid" } ; + +HELP: space->GL +{ $values { "space" "a space" } } +{ $description "display a space" } ; + +! -------------------------------------------------------------- +! light +! -------------------------------------------------------------- + +ARTICLE: "light-page" "Light in ADSODA" +"explanation of light" +$nl +"link to functions" +; + +ARTICLE: { "adsoda" "light" } "ADSODA : lights" +{ $code """ +! HELP: light position color +! ( -- tuple ) light new ; +! light est un vecteur avec 3 variables pour les couleurs\n + void Light::Apply(Vector& normal, double &cRed, double &cGreen, double &cBlue)\n + { \n + // Dot the light direction with the normalized normal of Face. + register double intensity = -(normal * (*this)); + // Face is a backface, from light's perspective + if (intensity < 0) + return; + + // Add the intensity componentwise + cRed += red * intensity; + cGreen += green * intensity; + cBlue += blue * intensity; + // Clip to unit range + if (cRed > 1.0) cRed = 1.0; + if (cGreen > 1.0) cGreen = 1.0; + if (cBlue > 1.0) cBlue = 1.0; +""" } +; + + + +ARTICLE: { "adsoda" "halfspace" } "ADSODA : halfspace" +" defined by the concatenation of the normal vector and a constant" + ; + + + +ARTICLE: "adsoda-main-page" "ADSODA : Arbitrary-Dimensional Solid Object Display Algorithm" +"multidimensional handler :" +$nl +"design a solid using face delimitations. Only works on convex shapes" +$nl +{ $emphasis "written in C++ by Greg Ferrar" } +$nl +"full explanation on adsoda page at " { $url "http://www.flowerfire.com/ADSODA/" } +$nl +"Useful words are describe on the following pages: " +{ $subsections + "face-page" + "solid-page" + "space-page" + "light-page" + "3D-rendering-page" +} ; + +ABOUT: "adsoda-main-page" diff --git a/adsoda/adsoda-tests.factor b/adsoda/adsoda-tests.factor new file mode 100644 index 0000000..1b90557 --- /dev/null +++ b/adsoda/adsoda-tests.factor @@ -0,0 +1,310 @@ +USING: adsoda +kernel +math +accessors +sequences + adsoda.solution2 + fry + tools.test + arrays ; + +IN: adsoda.tests + + + +: s1 ( -- solid ) + + 2 >>dimension + "s1" >>name + { 1 1 1 } >>color + { 1 -1 -5 } cut-solid + { -1 -1 -21 } cut-solid + { -1 0 -12 } cut-solid + { 1 2 16 } cut-solid +; +: solid1 ( -- solid ) + + 2 >>dimension + "solid1" >>name + { 1 -1 -5 } cut-solid + { -1 -1 -21 } cut-solid + { -1 0 -12 } cut-solid + { 1 2 16 } cut-solid + ensure-adjacencies + +; +: solid2 ( -- solid ) + + 2 >>dimension + "solid2" >>name + { -1 1 -10 } cut-solid + { -1 -1 -28 } cut-solid + { 1 0 13 } cut-solid + ! { 1 2 16 } cut-solid + ensure-adjacencies + +; + +: solid3 ( -- solid ) + + 2 >>dimension + "solid3" >>name + { 1 1 1 } >>color + { 1 0 16 } cut-solid + { -1 0 -36 } cut-solid + { 0 1 1 } cut-solid + { 0 -1 -17 } cut-solid + ! { 1 2 16 } cut-solid + ensure-adjacencies + + +; + +: solid4 ( -- solid ) + + 2 >>dimension + "solid4" >>name + { 1 1 1 } >>color + { 1 0 21 } cut-solid + { -1 0 -36 } cut-solid + { 0 1 1 } cut-solid + { 0 -1 -17 } cut-solid + ensure-adjacencies + +; + +: solid5 ( -- solid ) + + 2 >>dimension + "solid5" >>name + { 1 1 1 } >>color + { 1 0 6 } cut-solid + { -1 0 -17 } cut-solid + { 0 1 17 } cut-solid + { 0 -1 -19 } cut-solid + ensure-adjacencies + +; + +: solid7 ( -- solid ) + + 2 >>dimension + "solid7" >>name + { 1 1 1 } >>color + { 1 0 38 } cut-solid + { 1 -5 -66 } cut-solid + { -2 1 -75 } cut-solid + ensure-adjacencies + +; + +: solid6s ( -- seq ) + solid3 clone solid2 clone subtract +; + +: space1 ( -- space ) + + 2 >>dimension + ! solid3 suffix-solids + solid1 suffix-solids + solid2 suffix-solids + ! solid6s [ suffix-solids ] each + solid4 suffix-solids + ! solid5 suffix-solids + solid7 suffix-solids + { 1 1 1 } >>ambient-color + + { -100 -100 } >>position + { 0.2 0.7 0.1 } >>color + suffix-lights +; + +: space2 ( -- space ) + + 4 >>dimension + ! 4cube suffix-solids + { 1 1 1 } >>ambient-color + + { -100 -100 } >>position + { 0.2 0.7 0.1 } >>color + suffix-lights + + ; + + + +! { +! { 1 0 0 0 } +! { 0 1 0 0 } +! { 0 0 0.984807753012208 -0.1736481776669303 } +! { 0 0 0.1736481776669303 0.984807753012208 } +! } + +! ------------------------------------------------------------ +! constant+ +[ { 1 2 5 } ] [ { 1 2 3 } 2 constant+ ] unit-test + +! ------------------------------------------------------------ +! translate +[ { 1 -1 0 } ] [ { 1 -1 -5 } { 3 -2 } translate ] unit-test + +! ------------------------------------------------------------ +! transform +[ { -1 -1 -5 21.0 } ] [ { -1 -1 -5 21 } + { { 1 0 0 } + { 0 1 0 } + { 0 0 1 } + } transform +] unit-test + +! ------------------------------------------------------------ +! compare-nleft-to-identity-matrix +[ t ] [ + { + { 1 0 0 1232 } + { 0 1 0 0 321 } + { 0 0 1 0 } } + 3 compare-nleft-to-identity-matrix +] unit-test + +[ f ] [ + { { 1 0 0 } { 0 1 0 } { 0 0 0 } } + 3 compare-nleft-to-identity-matrix +] unit-test + +[ f ] [ + { { 2 0 0 } { 0 1 0 } { 0 0 1 } } + 3 compare-nleft-to-identity-matrix +] unit-test +! ------------------------------------------------------------ +[ t ] [ + { { 1 0 0 } + { 0 1 0 } + { 0 0 1 } } 3 valid-solution? +] unit-test + +[ f ] [ + { { 1 0 0 1 } + { 0 0 0 1 } + { 0 0 1 0 } } 3 valid-solution? +] unit-test + +[ f ] [ + { { 1 0 0 1 } + { 0 0 0 1 } } 3 valid-solution? +] unit-test + +[ f ] [ + { { 1 0 0 1 } + { 0 0 0 1 } + { 0 0 1 0 } } 2 valid-solution? +] unit-test + +! ------------------------------------------------------------ +[ 3 ] [ { 1 2 3 } last ] unit-test + +[ { 1 2 5 } ] [ { 1 2 3 } dup [ 2 + ] change-last ] unit-test + +! ------------------------------------------------------------ +! position-point +[ 0 ] [ + { 1 -1 -5 } { 2 7 } position-point +] unit-test + +! ------------------------------------------------------------ + +! transform +! TODO construire un exemple + + +! ------------------------------------------------------------ +! slice-solid + +! ------------------------------------------------------------ +! solve-equation +! deux cas de tests, avec solution et sans solution + +[ { 2 7 } ] +[ { { 1 -1 -5 } { 1 2 16 } } intersect-hyperplanes ] +unit-test + +[ f ] +[ { { 1 -1 -5 } { 1 2 16 } { -1 -1 -21 } } intersect-hyperplanes ] +unit-test + +[ f ] +[ { { 1 0 -5 } { 1 0 16 } } intersect-hyperplanes ] +unit-test + +! ------------------------------------------------------------ +! point-inside-halfspace +[ t ] [ { 1 -1 -5 } { 0 0 } point-inside-halfspace? ] +unit-test +[ f ] [ { 1 -1 -5 } { 8 13 } point-inside-halfspace? ] +unit-test +[ t ] [ { 1 -1 -5 } { 8 13 } point-inside-or-on-halfspace? ] +unit-test + + +! ------------------------------ +! order solid + +[ 1 ] [ 0 >pv solid1 solid2 order-solid ] unit-test +[ -1 ] [ 0 >pv solid2 solid1 order-solid ] unit-test +[ f ] [ 1 >pv solid1 solid2 order-solid ] unit-test +[ f ] [ 1 >pv solid2 solid1 order-solid ] unit-test + + +! clip-solid +[ { { 13 15 } { 15 13 } { 13 13 } } ] + [ 0 >pv solid2 solid1 clip-solid first corners>> ] unit-test + +solid1 corners>> '[ _ ] + [ 0 >pv solid1 solid1 clip-solid first corners>> ] unit-test + +solid1 corners>> '[ _ ] + [ 0 >pv solid1 solid2 clip-solid first corners>> ] unit-test + +solid1 corners>> '[ _ ] + [ 1 >pv solid1 solid2 clip-solid first corners>> ] unit-test +solid2 corners>> '[ _ ] + [ 1 >pv solid2 solid1 clip-solid first corners>> ] unit-test + +! +[ + { + { { 13 15 } { 15 13 } { 13 13 } } + { { 16 17 } { 16 13 } { 36 17 } { 36 13 } } + { { 16 1 } { 16 2 } { 36 1 } { 36 2 } } + } +] [ 0 >pv solid2 solid3 2array + solid1 (solids-silhouette-subtract) + [ corners>> ] map + ] unit-test + + +[ +{ + { { 8 13 } { 2 7 } { 12 9 } { 12 2 } } + { { 13 15 } { 15 13 } { 13 13 } } + { { 16 17 } { 16 15 } { 36 17 } { 36 15 } } + { { 16 1 } { 16 2 } { 36 1 } { 36 2 } } +} +] [ + 0 >pv solid1 suffix-solids + solid2 suffix-solids + solid3 suffix-solids + remove-hidden-solids + solids>> [ corners>> ] map +] unit-test + +! { } +! { } +! { 0.2 0.3 0.4 } >>color { 1 -1 1 } >>direction suffix +! { 0.4 0.3 0.1 } >>color { -1 -1 -1 } >>direction suffix +! suffix +! { 0.1 0.1 0.1 } suffix ! ambient color +! { 0.23 0.32 0.17 } suffix ! solid color +! solid3 faces>> first + +! enlight-projection diff --git a/adsoda/adsoda.factor b/adsoda/adsoda.factor new file mode 100644 index 0000000..f6987dc --- /dev/null +++ b/adsoda/adsoda.factor @@ -0,0 +1,569 @@ +! Copyright (C) 2008 Jeff Bigot +! See http://factorcode.org/license.txt for BSD license. +USING: accessors +arrays +assocs +combinators +kernel +fry +math +math.constants +math.functions +math.libm +math.order +math.vectors +math.matrices +math.parser +namespaces +prettyprint +sequences +sequences.deep +sets +slots +sorting +tools.time +vars +continuations +words +opengl +opengl.gl +colors +adsoda.solution2 +adsoda.combinators +opengl.demo-support +values +tools.walker +; + +IN: adsoda + +DEFER: combinations +VAR: pv + + +! ------------------------------------------------------------- +! global values +VALUE: remove-hidden-solids? +VALUE: VERY-SMALL-NUM +VALUE: ZERO-VALUE +VALUE: MAX-FACE-PER-CORNER + +t \ remove-hidden-solids? set-value +0.0000001 \ VERY-SMALL-NUM set-value +0.0000001 \ ZERO-VALUE set-value +4 \ MAX-FACE-PER-CORNER set-value +! ------------------------------------------------------------- +! sequence complement + +: with-pv ( i quot -- ) [ swap >pv call ] with-scope ; inline + +: dimension ( array -- x ) length 1 - ; inline +: change-last ( seq quot -- ) + [ [ dimension ] keep ] dip change-nth ; inline + +! ------------------------------------------------------------- +! light +! ------------------------------------------------------------- + +TUPLE: light name { direction array } color ; +: ( -- tuple ) light new ; + +! ------------------------------------------------------------- +! halfspace manipulation +! ------------------------------------------------------------- + +: constant+ ( v x -- w ) '[ [ _ + ] change-last ] keep ; +: translate ( u v -- w ) dupd v* sum constant+ ; + +: transform ( u matrix -- w ) + [ swap m.v ] 2keep ! compute new normal vector + [ + [ [ abs ZERO-VALUE > ] find ] keep + ! find a point on the frontier + ! be sure it's not null vector + last ! get constant + swap /f neg swap ! intercept value + ] dip + flip + nth + [ * ] with map ! apply intercep value + over v* + sum neg + suffix ! add value as constant at the end of equation +; + +: position-point ( halfspace v -- x ) + -1 suffix v* sum ; inline +: point-inside-halfspace? ( halfspace v -- ? ) + position-point VERY-SMALL-NUM > ; +: point-inside-or-on-halfspace? ( halfspace v -- ? ) + position-point VERY-SMALL-NUM neg > ; +: project-vector ( seq -- seq ) + pv> [ head ] [ 1 + tail ] 2bi append ; +: get-intersection ( matrice -- seq ) + [ 1 tail* ] map flip first ; + +: islenght=? ( seq n -- seq n ? ) 2dup [ length ] [ = ] bi* ; + +: compare-nleft-to-identity-matrix ( seq n -- ? ) + [ [ head ] curry map ] keep identity-matrix m- + flatten + [ abs ZERO-VALUE < ] all? +; + +: valid-solution? ( matrice n -- ? ) + islenght=? + [ compare-nleft-to-identity-matrix ] + [ 2drop f ] if ; inline + +: intersect-hyperplanes ( matrice -- seq ) + [ solution dup ] [ first dimension ] bi + valid-solution? [ get-intersection ] [ drop f ] if ; + +! ------------------------------------------------------------- +! faces +! ------------------------------------------------------------- + +TUPLE: face { halfspace array } + touching-corners adjacent-faces ; +: ( v -- tuple ) face new swap >>halfspace ; +: flip-face ( face -- face ) [ vneg ] change-halfspace ; +: erase-face-touching-corners ( face -- face ) + f >>touching-corners ; +: erase-face-adjacent-faces ( face -- face ) + f >>adjacent-faces ; +: faces-intersection ( faces -- v ) + [ halfspace>> ] map intersect-hyperplanes ; +: face-translate ( face v -- face ) + [ translate ] curry change-halfspace ; inline +: face-transform ( face m -- face ) + [ transform ] curry change-halfspace ; inline +: face-orientation ( face -- x ) pv> swap halfspace>> nth sgn ; +: backface? ( face -- face ? ) dup face-orientation 0 <= ; +: pv-factor ( face -- f face ) + halfspace>> [ pv> swap nth [ * ] curry ] keep ; inline +: suffix-touching-corner ( face corner -- face ) + [ suffix ] curry change-touching-corners ; inline +: real-face? ( face -- ? ) + [ touching-corners>> length ] + [ halfspace>> dimension ] bi >= ; + +: (add-to-adjacent-faces) ( face face -- face ) + over adjacent-faces>> 2dup member? + [ 2drop ] [ swap suffix >>adjacent-faces ] if ; + +: add-to-adjacent-faces ( face face -- face ) + 2dup = [ drop ] [ (add-to-adjacent-faces) ] if ; + +: update-adjacent-faces ( faces corner -- ) + '[ [ _ suffix-touching-corner drop ] each ] keep + 2 among [ + [ first ] keep second + [ add-to-adjacent-faces drop ] 2keep + swap add-to-adjacent-faces drop + ] each ; inline + +: face-project-dim ( face -- x ) halfspace>> length 2 - ; + +: apply-light ( color light normal -- u ) + over direction>> v. + neg dup 0 > + [ + [ color>> swap ] dip + [ * ] curry map v+ + [ 1 min ] map + ] + [ 2drop ] + if +; + +: enlight-projection ( array face -- color ) + ! array = lights + ambient color + [ [ third ] [ second ] [ first ] tri ] + [ halfspace>> project-vector normalize ] bi* + [ apply-light ] curry each + v* +; + +: (intersection-into-face) ( face-init face-adja quot -- face ) + [ + [ [ pv-factor ] bi@ + roll + [ map ] 2bi@ + v- + ] 2keep + [ touching-corners>> ] bi@ + [ swap [ = ] curry find nip f = ] curry find nip + ] dip over + [ + call + dupd + point-inside-halfspace? [ vneg ] unless + + ] [ 3drop f ] if + ; inline + +: intersection-into-face ( face-init face-adja -- face ) + [ [ project-vector ] bi@ ] (intersection-into-face) ; + +: intersection-into-silhouette-face ( face-init face-adja -- face ) + [ ] (intersection-into-face) ; + +: intersections-into-faces ( face -- faces ) + clone dup + adjacent-faces>> [ intersection-into-face ] with map + sift ; + +: (face-silhouette) ( face -- faces ) + clone dup adjacent-faces>> + [ backface? + [ intersection-into-silhouette-face ] [ 2drop f ] if + ] with map + sift +; inline + +: face-silhouette ( face -- faces ) + backface? [ drop f ] [ (face-silhouette) ] if ; + +! -------------------------------- +! solid +! ------------------------------------------------------------- +TUPLE: solid dimension silhouettes + faces corners adjacencies-valid color name ; + +: ( -- tuple ) solid new ; + +: suffix-silhouettes ( solid silhouette -- solid ) + [ suffix ] curry change-silhouettes ; + +: suffix-face ( solid face -- solid ) + [ suffix ] curry change-faces ; +: suffix-corner ( solid corner -- solid ) + [ suffix ] curry change-corners ; +: erase-solid-corners ( solid -- solid ) f >>corners ; + +: erase-silhouettes ( solid -- solid ) + dup dimension>> f >>silhouettes ; +: filter-real-faces ( solid -- solid ) + [ [ real-face? ] filter ] change-faces ; +: initiate-solid-from-face ( face -- solid ) + face-project-dim swap >>dimension ; + +: erase-old-adjacencies ( solid -- solid ) + erase-solid-corners + [ dup [ erase-face-touching-corners + erase-face-adjacent-faces drop ] each ] + change-faces ; + +: point-inside-or-on-face? ( face v -- ? ) + [ halfspace>> ] dip point-inside-or-on-halfspace? ; + +: point-inside-face? ( face v -- ? ) + [ halfspace>> ] dip point-inside-halfspace? ; + +: point-inside-solid? ( solid point -- ? ) + [ faces>> ] dip [ point-inside-face? ] curry all? ; inline + +: point-inside-or-on-solid? ( solid point -- ? ) + [ faces>> ] dip + [ point-inside-or-on-face? ] curry all? ; inline + +: unvalid-adjacencies ( solid -- solid ) + erase-old-adjacencies f >>adjacencies-valid + erase-silhouettes ; + +: add-face ( solid face -- solid ) + suffix-face unvalid-adjacencies ; + +: cut-solid ( solid halfspace -- solid ) add-face ; + +: slice-solid ( solid face -- solid1 solid2 ) + [ [ clone ] bi@ flip-face add-face + [ "/outer/" append ] change-name ] 2keep + add-face [ "/inner/" append ] change-name ; + +! ------------- + + +: add-silhouette ( solid -- solid ) + dup + ! find-adjacencies + faces>> { } + [ face-silhouette append ] reduce + sift + + swap >>faces + over dimension>> >>dimension + over name>> " silhouette " append + pv> number>string append + >>name + ! ensure-adjacencies + suffix-silhouettes ; inline + +: find-silhouettes ( solid -- solid ) + { } >>silhouettes + dup dimension>> [ [ add-silhouette ] with-pv ] each ; + +: ensure-silhouettes ( solid -- solid ) + dup silhouettes>> [ f = ] all? + [ find-silhouettes ] when ; + +! ------------ + +: corner-added? ( solid corner -- ? ) + ! add corner to solid if it is inside solid + [ ] + [ point-inside-or-on-solid? ] + [ swap corners>> member? not ] + 2tri and + [ suffix-corner drop t ] [ 2drop f ] if ; + +: process-corner ( solid faces corner -- ) + swapd + [ corner-added? ] keep swap ! test if corner is inside solid + [ update-adjacent-faces ] + [ 2drop ] + if ; + +: compute-intersection ( solid faces -- ) + dup faces-intersection + dup f = [ 3drop ] [ process-corner ] if ; + +: test-faces-combinaisons ( solid n -- ) + [ dup faces>> ] dip among + [ compute-intersection ] with each ; + +: compute-adjacencies ( solid -- solid ) + dup dimension>> [ >= ] curry + [ keep swap ] curry MAX-FACE-PER-CORNER swap + [ [ test-faces-combinaisons ] 2keep 1 - ] while drop ; + +: find-adjacencies ( solid -- solid ) + erase-old-adjacencies + compute-adjacencies + filter-real-faces + t >>adjacencies-valid ; + +: ensure-adjacencies ( solid -- solid ) + dup adjacencies-valid>> + [ find-adjacencies ] unless + ensure-silhouettes + ; + +: (non-empty-solid?) ( solid -- ? ) + [ dimension>> ] [ corners>> length ] bi < ; +: non-empty-solid? ( solid -- ? ) + ensure-adjacencies (non-empty-solid?) ; + +: compare-corners-roughly ( corner corner -- ? ) + 2drop t ; +! : remove-inner-faces ( -- ) ; +: face-project ( array face -- seq ) + backface? + [ 2drop f ] + [ [ enlight-projection ] + [ initiate-solid-from-face ] + [ intersections-into-faces ] tri + >>faces + swap >>color + ] if ; + +: solid-project ( lights ambient solid -- solids ) + ensure-adjacencies + [ color>> ] [ faces>> ] bi [ 3array ] dip + [ face-project ] with map + sift + [ ensure-adjacencies ] map +; + +: (solid-move) ( solid v move -- solid ) + curry [ map ] curry + [ dup faces>> ] dip call drop + unvalid-adjacencies ; inline + +: solid-translate ( solid v -- solid ) + [ face-translate ] (solid-move) ; +: solid-transform ( solid m -- solid ) + [ face-transform ] (solid-move) ; + +: find-corner-in-silhouette ( s1 s2 -- elt bool ) + pv> swap silhouettes>> nth + swap corners>> + [ point-inside-solid? ] with find swap ; + +: valid-face-for-order ( solid point -- face ) + [ point-inside-face? not ] + [ drop face-orientation 0 = not ] 2bi and ; + +: check-orientation ( s1 s2 pt -- int ) + [ nip faces>> ] dip + [ valid-face-for-order ] curry find swap + [ face-orientation ] [ drop f ] if ; + +: (order-solid) ( s1 s2 -- int ) + 2dup find-corner-in-silhouette + [ check-orientation ] [ 3drop f ] if ; + +: order-solid ( solid solid -- i ) + 2dup (order-solid) + [ 2nip ] + [ swap (order-solid) + [ neg ] [ f ] if* + ] if* ; + +: subtract ( solid1 solid2 -- solids ) + faces>> swap clone ensure-adjacencies ensure-silhouettes + [ swap slice-solid drop ] curry map + [ non-empty-solid? ] filter + [ ensure-adjacencies ] map +; inline + +! ------------------------------------------------------------- +! space +! ------------------------------------------------------------- +TUPLE: space name dimension solids ambient-color lights ; +: ( -- space ) space new ; +: suffix-solids ( space solid -- space ) + [ suffix ] curry change-solids ; inline +: suffix-lights ( space light -- space ) + [ suffix ] curry change-lights ; inline +: clear-space-solids ( space -- space ) f >>solids ; + +: space-ensure-solids ( space -- space ) + [ [ ensure-adjacencies ] map ] change-solids ; +: eliminate-empty-solids ( space -- space ) + [ [ non-empty-solid? ] filter ] change-solids ; + +: projected-space ( space solids -- space ) + swap dimension>> 1 - + swap >>dimension swap >>solids ; + +: get-silhouette ( solid -- silhouette ) + silhouettes>> pv> swap nth ; +: solid= ( solid solid -- ? ) [ corners>> ] same? ; + +: space-apply ( space m quot -- space ) + curry [ map ] curry [ dup solids>> ] dip + [ call ] [ 2drop ] recover drop ; inline +: space-transform ( space m -- space ) + [ solid-transform ] space-apply ; +: space-translate ( space v -- space ) + [ solid-translate ] space-apply ; + +: describe-space ( space -- ) + solids>> + [ [ corners>> [ pprint ] each ] [ name>> . ] bi ] each ; + +: clip-solid ( solid solid -- solids ) + [ ] + [ solid= not ] + [ order-solid -1 = ] 2tri + and + [ get-silhouette subtract ] + [ drop 1array ] + if + + ; + +: (solids-silhouette-subtract) ( solids solid -- solids ) + [ clip-solid append ] curry { } -rot each ; inline + +: solids-silhouette-subtract ( solids i solid -- solids ) +! solids is an array of 1 solid arrays + [ (solids-silhouette-subtract) ] curry map-but +; inline + +: remove-hidden-solids ( space -- space ) +! We must include each solid in a sequence because +! during substration +! a solid can be divided in more than on solid + [ + [ [ 1array ] map ] + [ length ] + [ ] + tri + [ solids-silhouette-subtract ] 2each + { } [ append ] reduce + ] change-solids + eliminate-empty-solids ! TODO include into change-solids +; + +: space-project ( space i -- space ) + [ + [ clone + remove-hidden-solids? [ remove-hidden-solids ] when + dup + [ solids>> ] + [ lights>> ] + [ ambient-color>> ] tri + [ rot solid-project ] 2curry + map + [ append ] { } -rot each + ! TODO project lights + projected-space + ! remove-inner-faces + ! + eliminate-empty-solids + ] with-pv + ] [ 3drop ] recover + ; inline + +: middle-of-space ( space -- point ) + solids>> [ corners>> ] map concat + [ [ ] [ v+ ] map-reduce ] [ length ] bi v/n +; + +! ------------------------------------------------------------- +! 3D rendering +! ------------------------------------------------------------- + +: face-reference ( face -- halfspace point vect ) + [ halfspace>> ] + [ touching-corners>> first ] + [ touching-corners>> second ] tri + over v- +; + +: theta ( v halfspace point vect -- v x ) + [ [ over ] dip v- ] dip + [ cross dup norm >float ] + [ v. >float ] + 2bi + fatan2 + -rot v. + 0 < [ neg ] when +; + +: ordered-face-points ( face -- corners ) + [ touching-corners>> 1 head ] + [ touching-corners>> 1 tail ] + [ face-reference [ theta ] 3curry ] tri + { } map>assoc sort-values keys + append + ; inline + +: point->GL ( point -- ) gl-vertex ; +: points->GL ( array -- ) do-cycle [ point->GL ] each ; + +: face->GL ( face color -- ) + [ ordered-face-points ] dip + [ first3 1.0 glColor4d GL_POLYGON + [ [ point->GL ] each ] do-state ] curry + [ 0 0 0 1 glColor4d GL_LINE_LOOP + [ [ point->GL ] each ] do-state ] + bi + ; inline + +: solid->GL ( solid -- ) + [ faces>> ] + [ color>> ] bi + [ face->GL ] curry each ; inline + +: space->GL ( space -- ) + solids>> + [ solid->GL ] each ; + + + + + diff --git a/adsoda/adsoda.tests b/adsoda/adsoda.tests new file mode 100644 index 0000000..f0b0c54 --- /dev/null +++ b/adsoda/adsoda.tests @@ -0,0 +1,147 @@ +! : init-4D-demo ( -- space ) +! OK +! espace de dimension 4 et de couleur 0,3 0.3 0.3 + + 4 >>dimension + { 0.3 0.3 0.3 } >>ambient-color + { 100 150 100 150 100 150 100 150 } "4cube1" 4cube suffix-solids + { 160 180 160 180 160 180 160 180 } "4cube2" 4cube suffix-solids + + { -100 -100 -100 -100 } >>position + { 0.2 0.7 0.1 } >>color + suffix-lights +! ; +! : init-3D-demo ( -- space ) +! OK +! espace de dimension 4 et de couleur 0,3 0.3 0.3 + + 3 >>dimension + { 0.3 0.3 0.3 } >>ambient-color + { 100 150 100 150 100 150 } "3cube1" 3cube suffix-solids + ! { -150 -10 -150 -10 -150 -10 -150 -10 } "4cube2" 4cube suffix-solids + + { -100 -100 -100 -100 } >>position + { 0.2 0.7 0.1 } >>color + suffix-lights +! ; + + +: s1 ( -- solid ) + + 2 >>dimension + "s1" >>name + { 1 1 1 } >>color + { 1 -1 -5 } cut-solid + { -1 -1 -21 } cut-solid + { -1 0 -12 } cut-solid + { 1 2 16 } cut-solid +; +: solid1 ( -- solid ) + + 2 >>dimension + "solid1" >>name + { 1 -1 -5 } cut-solid + { -1 -1 -21 } cut-solid + { -1 0 -12 } cut-solid + { 1 2 16 } cut-solid + ensure-adjacencies + +; +: solid2 ( -- solid ) + + 2 >>dimension + "solid2" >>name + { -1 1 -10 } cut-solid + { -1 -1 -28 } cut-solid + { 1 0 13 } cut-solid + ! { 1 2 16 } cut-solid + ensure-adjacencies + +; + +: solid3 ( -- solid ) + + 2 >>dimension + "solid3" >>name + { 1 1 1 } >>color + { 1 0 16 } cut-solid + { -1 0 -36 } cut-solid + { 0 1 1 } cut-solid + { 0 -1 -17 } cut-solid + ! { 1 2 16 } cut-solid + ensure-adjacencies + + +; + +: solid4 ( -- solid ) + + 2 >>dimension + "solid4" >>name + { 1 1 1 } >>color + { 1 0 21 } cut-solid + { -1 0 -36 } cut-solid + { 0 1 1 } cut-solid + { 0 -1 -17 } cut-solid + ensure-adjacencies + +; + +: solid5 ( -- solid ) + + 2 >>dimension + "solid5" >>name + { 1 1 1 } >>color + { 1 0 6 } cut-solid + { -1 0 -17 } cut-solid + { 0 1 17 } cut-solid + { 0 -1 -19 } cut-solid + ensure-adjacencies + +; + +: solid7 ( -- solid ) + + 2 >>dimension + "solid7" >>name + { 1 1 1 } >>color + { 1 0 38 } cut-solid + { 1 -5 -66 } cut-solid + { -2 1 -75 } cut-solid + ensure-adjacencies + +; + +: solid6s ( -- seq ) + solid3 clone solid2 clone subtract +; + +: space1 ( -- space ) + + 2 >>dimension + ! solid3 suffix-solids + solid1 suffix-solids + solid2 suffix-solids + ! solid6s [ suffix-solids ] each + solid4 suffix-solids + ! solid5 suffix-solids + solid7 suffix-solids + { 1 1 1 } >>ambient-color + + { -100 -100 } >>position + { 0.2 0.7 0.1 } >>color + suffix-lights +; + +: space2 ( -- space ) + + 4 >>dimension + ! 4cube suffix-solids + { 1 1 1 } >>ambient-color + + { -100 -100 } >>position + { 0.2 0.7 0.1 } >>color + suffix-lights + + ; + diff --git a/adsoda/authors.txt b/adsoda/authors.txt new file mode 100644 index 0000000..856f3b0 --- /dev/null +++ b/adsoda/authors.txt @@ -0,0 +1,2 @@ +Jeff Bigot +Greg Ferrar \ No newline at end of file diff --git a/adsoda/combinators/authors.txt b/adsoda/combinators/authors.txt new file mode 100644 index 0000000..e7f4cde --- /dev/null +++ b/adsoda/combinators/authors.txt @@ -0,0 +1 @@ +JF Bigot, after Greg Ferrar \ No newline at end of file diff --git a/adsoda/combinators/combinators-docs.factor b/adsoda/combinators/combinators-docs.factor new file mode 100644 index 0000000..5b540e7 --- /dev/null +++ b/adsoda/combinators/combinators-docs.factor @@ -0,0 +1,39 @@ +! Copyright (C) 2008 Jeff Bigot. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays help.markup help.syntax kernel sequences ; +IN: adsoda.combinators + +HELP: among +{ $values + { "array" array } { "n" "number of value to select" } + { "array" array } +} +{ $description "returns an array containings every possibilities of n choices among a given sequence" } ; + +HELP: columnize +{ $values + { "array" array } + { "array" array } +} +{ $description "flip a sequence into a sequence of 1 element sequences" } ; + +HELP: concat-nth +{ $values + { "seq1" sequence } { "seq2" sequence } + { "seq" sequence } +} +{ $description "merges 2 sequences of sequences appending corresponding elements" } ; + +HELP: do-cycle +{ $values + { "array" array } + { "array" array } +} +{ $description "Copy the first element at the end of the sequence in order to close the cycle." } ; + + +ARTICLE: "adsoda.combinators" "Combinators" +{ $vocab-link "adsoda.combinators" } +; + +ABOUT: "adsoda.combinators" diff --git a/adsoda/combinators/combinators-tests.factor b/adsoda/combinators/combinators-tests.factor new file mode 100644 index 0000000..d46dc14 --- /dev/null +++ b/adsoda/combinators/combinators-tests.factor @@ -0,0 +1,11 @@ +USING: adsoda.combinators +sequences + tools.test + ; + +IN: adsoda.combinators.tests + + +[ { "atoto" "b" "ctoto" } ] [ { "a" "b" "c" } 1 [ "toto" append ] map-but ] + unit-test + diff --git a/adsoda/combinators/combinators.factor b/adsoda/combinators/combinators.factor new file mode 100644 index 0000000..dfa0130 --- /dev/null +++ b/adsoda/combinators/combinators.factor @@ -0,0 +1,45 @@ +! Copyright (C) 2008 Jeff Bigot +! See http://factorcode.org/license.txt for BSD license. +USING: kernel arrays sequences fry math combinators ; + +IN: adsoda.combinators + +! : (combinations) ( seq -- seq ) [ 1 tail ] dip combinations ; + +! : prefix-each [ prefix ] curry map ; inline + +! : combinations ( seq n -- seqs ) +! { +! { [ dup 0 = ] [ 2drop { { } } ] } +! { [ over empty? ] [ 2drop { } ] } +! { [ t ] [ +! [ [ 1 - (combinations) ] [ drop first ] 2bi prefix-each ] +! [ (combinations) ] 2bi append +! ] } +! } cond ; + +: columnize ( array -- array ) [ 1array ] map ; inline + +: among ( array n -- array ) + 2dup swap length + { + { [ over 1 = ] [ 3drop columnize ] } + { [ over 0 = ] [ 4drop { } ] } + { [ 2dup < ] [ 2drop [ 1 cut ] dip + [ 1 - among [ append ] with map ] + [ among append ] 2bi + ] } + { [ 2dup = ] [ 3drop 1array ] } + { [ 2dup > ] [ 4drop { } ] } + } cond +; + +: concat-nth ( seq1 seq2 -- seq ) + [ nth append ] curry map-index ; + +: do-cycle ( array -- array ) dup first suffix ; + +: map-but ( seq i quot -- seq ) + ! quot : ( seq x -- seq ) + '[ _ = [ @ ] unless ] map-index ; inline + diff --git a/adsoda/solution2/solution2.factor b/adsoda/solution2/solution2.factor new file mode 100644 index 0000000..9b75e05 --- /dev/null +++ b/adsoda/solution2/solution2.factor @@ -0,0 +1,126 @@ +USING: kernel +sequences +namespaces + +math +math.vectors +math.matrices +; +IN: adsoda.solution2 + +! ------------------- +! correctif solution +! --------------- +SYMBOL: matrix +: MIN-VAL-adsoda ( -- x ) 0.00000001 +! 0.000000000001 +; + +: zero? ( x -- ? ) + abs MIN-VAL-adsoda < +; + +! [ number>string string>number ] map + +: with-matrix ( matrix quot -- ) + [ swap matrix set call matrix get ] with-scope ; inline + +: nth-row ( row# -- seq ) matrix get nth ; + +: change-row ( row# quot -- seq ) ! row# quot -- | quot: seq -- seq ) + matrix get swap change-nth ; inline + +: exchange-rows ( row# row# -- ) matrix get exchange ; + +: rows ( -- n ) matrix get length ; + +: cols ( -- n ) 0 nth-row length ; + +: skip ( i seq quot -- n ) + over [ find-from drop ] dip length or ; inline + +: first-col ( row# -- n ) + ! First non-zero column + 0 swap nth-row [ zero? not ] skip ; + +: clear-scale ( col# pivot-row i-row -- n ) + [ over ] dip nth dup zero? [ + 3drop 0 + ] [ + [ nth dup zero? ] dip swap [ + 2drop 0 + ] [ + swap / neg + ] if + ] if ; + +: (clear-col) ( col# pivot-row i -- ) + [ [ clear-scale ] 2keep [ n*v ] dip v+ ] change-row ; + +: rows-from ( row# -- slice ) + rows dup ; + +: clear-col ( col# row# rows -- ) + [ nth-row ] dip [ [ 2dup ] dip (clear-col) ] each 2drop ; + +: do-row ( exchange-with row# -- ) + [ exchange-rows ] keep + [ first-col ] keep + dup 1 + rows-from clear-col ; + +: find-row ( row# quot -- i elt ) + [ rows-from ] dip find ; inline + +: pivot-row ( col# row# -- n ) + [ dupd nth-row nth zero? not ] find-row 2nip ; + +: (echelon) ( col# row# -- ) + over cols < over rows < and [ + 2dup pivot-row [ over do-row 1 + ] when* + [ 1 + ] dip (echelon) + ] [ + 2drop + ] if ; + +: echelon ( matrix -- matrix' ) + [ 0 0 (echelon) ] with-matrix ; + +: nonzero-rows ( matrix -- matrix' ) + [ [ zero? ] all? ] reject ; + +: null/rank ( matrix -- null rank ) + echelon dup length swap nonzero-rows length [ - ] keep ; + +: leading ( seq -- n elt ) [ zero? not ] find ; + +: reduced ( matrix' -- matrix'' ) + [ + rows [ + dup nth-row leading drop + dup [ swap dup clear-col ] [ 2drop ] if + ] each + ] with-matrix ; + +: basis-vector ( row col# -- ) + [ clone ] dip + [ swap nth neg recip ] 2keep + [ 0 spin set-nth ] 2keep + [ n*v ] dip + matrix get set-nth ; + +: nullspace ( matrix -- seq ) + echelon reduced dup empty? [ + dup first length identity-matrix [ + [ + dup leading drop + dup [ basis-vector ] [ 2drop ] if + ] each + ] with-matrix flip nonzero-rows + ] unless ; + +: 1-pivots ( matrix -- matrix ) + [ dup leading nip [ recip v*n ] when* ] map ; + +: solution ( matrix -- matrix ) + echelon nonzero-rows reduced 1-pivots ; + diff --git a/adsoda/solution2/summary.txt b/adsoda/solution2/summary.txt new file mode 100644 index 0000000..a25a451 --- /dev/null +++ b/adsoda/solution2/summary.txt @@ -0,0 +1 @@ +A modification of solution to approximate solutions \ No newline at end of file diff --git a/adsoda/summary.txt b/adsoda/summary.txt new file mode 100644 index 0000000..ee666bc --- /dev/null +++ b/adsoda/summary.txt @@ -0,0 +1 @@ +ADSODA : Arbitrary-Dimensional Solid Object Display Algorithm \ No newline at end of file diff --git a/adsoda/tags.txt b/adsoda/tags.txt new file mode 100644 index 0000000..6e25b2f --- /dev/null +++ b/adsoda/tags.txt @@ -0,0 +1 @@ +adsoda 4D viewer \ No newline at end of file diff --git a/adsoda/tools/authors.txt b/adsoda/tools/authors.txt new file mode 100644 index 0000000..6536f34 --- /dev/null +++ b/adsoda/tools/authors.txt @@ -0,0 +1 @@ +Jeff Bigot diff --git a/adsoda/tools/tools-docs.factor b/adsoda/tools/tools-docs.factor new file mode 100644 index 0000000..1d952e3 --- /dev/null +++ b/adsoda/tools/tools-docs.factor @@ -0,0 +1,62 @@ +! Copyright (C) 2008 Jeff Bigot. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays help.markup help.syntax kernel sequences ; +IN: adsoda.tools + +HELP: 3cube +{ $values + { "array" "array" } { "name" "name" } + { "solid" "solid" } +} +{ $description "array : xmin xmax ymin ymax zmin zmax" +"returns a 3D solid with given limits" +} ; + +HELP: 4cube +{ $values + { "array" "array" } { "name" "name" } + { "solid" "solid" } +} +{ $description "array : xmin xmax ymin ymax zmin zmax wmin wmax" +"returns a 4D solid with given limits" +} ; + + +HELP: equation-system-for-normal +{ $values + { "points" "a list of n points" } + { "matrix" "matrix" } +} +{ $description "From a list of points, return the matrix" +"to solve in order to find the vector normal to the plan defined by the points" } +; + +HELP: normal-vector +{ $values + { "points" "a list of n points" } + { "v" "a vector" } +} +{ $description "From a list of points, returns the vector normal to the plan defined by the points" +"With n points, creates n-1 vectors and then find a vector orthogonal to every others" +"returns { f } if a normal vector can not be found" } +; + +HELP: points-to-hyperplane +{ $values + { "points" "a list of n points" } + { "hyperplane" "an hyperplane equation" } +} +{ $description "From a list of points, returns the equation of the hyperplan" +"Finds a normal vector and then translate it so that it includes one of the points" + +} +; + +ARTICLE: "adsoda.tools" "Tools" +{ $vocab-link "adsoda.tools" } +"Tools to help in building an " { $vocab-link "adsoda" } "-space" +; + +ABOUT: "adsoda.tools" + + diff --git a/adsoda/tools/tools-tests.factor b/adsoda/tools/tools-tests.factor new file mode 100644 index 0000000..5d1ffa5 --- /dev/null +++ b/adsoda/tools/tools-tests.factor @@ -0,0 +1,14 @@ +! Copyright (C) 2008 Jeff Bigot +! See http://factorcode.org/license.txt for BSD license. +USING: +adsoda.tools +tools.test +; + +IN: adsoda.tools.tests + + + [ { 1 0 } ] [ { { 0 0 } { 0 1 } } normal-vector ] unit-test + [ f ] [ { { 0 0 } { 0 0 } } normal-vector ] unit-test + + [ { 1/2 1/2 1+1/2 } ] [ { { 1 2 } { 2 1 } } points-to-hyperplane ] unit-test diff --git a/adsoda/tools/tools.factor b/adsoda/tools/tools.factor new file mode 100644 index 0000000..69d8a38 --- /dev/null +++ b/adsoda/tools/tools.factor @@ -0,0 +1,150 @@ +! Copyright (C) 2008 Jeff Bigot +! See http://factorcode.org/license.txt for BSD license. +USING: +kernel +sequences +math +accessors +adsoda +math.vectors +math.matrices +bunny.model +io.encodings.ascii +io.files +sequences.deep +combinators +adsoda.combinators +fry +io.files.temp +grouping +; + +IN: adsoda.tools + + + + + +! --------------------------------- +: coord-min ( x array -- array ) swap suffix ; +: coord-max ( x array -- array ) swap neg suffix ; + +: 4cube ( array name -- solid ) +! array : xmin xmax ymin ymax zmin zmax wmin wmax + + 4 >>dimension + swap >>name + swap + { + [ { 1 0 0 0 } coord-min ] [ { -1 0 0 0 } coord-max ] + [ { 0 1 0 0 } coord-min ] [ { 0 -1 0 0 } coord-max ] + [ { 0 0 1 0 } coord-min ] [ { 0 0 -1 0 } coord-max ] + [ { 0 0 0 1 } coord-min ] [ { 0 0 0 -1 } coord-max ] + } + [ curry call ] 2map + [ cut-solid ] each + ensure-adjacencies + +; inline + +: 3cube ( array name -- solid ) +! array : xmin xmax ymin ymax zmin zmax wmin wmax + + 3 >>dimension + swap >>name + swap + { + [ { 1 0 0 } coord-min ] [ { -1 0 0 } coord-max ] + [ { 0 1 0 } coord-min ] [ { 0 -1 0 } coord-max ] + [ { 0 0 1 } coord-min ] [ { 0 0 -1 } coord-max ] + } + [ curry call ] 2map + [ cut-solid ] each + ensure-adjacencies + +; inline + + +: equation-system-for-normal ( points -- matrix ) + unclip [ v- 0 suffix ] curry map + dup first [ drop 1 ] map suffix +; + +: normal-vector ( points -- v ) + equation-system-for-normal + intersect-hyperplanes ; + +: points-to-hyperplane ( points -- hyperplane ) + [ normal-vector 0 suffix ] [ first ] bi + translate ; + +: refs-to-points ( points faces -- faces ) + [ swap [ nth 10 v*n { 100 100 100 } v+ ] curry map ] + with map +; +! V{ { 0.1 0.2 } { 1.1 1.3 } } V{ { 1 0 } { 0 1 } } +! V{ { { 1.1 1.3 } { 0.1 0.2 } } { { 0.1 0.2 } { 1.1 1.3 } } } + +: ply-model-path ( -- path ) + +! "bun_zipper.ply" +"screw2.ply" +temp-file +; + +: read-bunny-model ( -- v ) +ply-model-path ascii [ parse-model ] with-file-reader + +refs-to-points +; + +: 3points-to-normal ( seq -- v ) + unclip [ v- ] curry map first2 cross normalize +; +: 2-faces-to-prism ( seq seq -- seq ) + 2dup + [ do-cycle 2 clump ] bi@ concat-nth + ! 3 faces rectangulaires + swap prefix + swap prefix +; + +: Xpoints-to-prisme ( seq height -- cube ) + ! from 3 points gives a list of faces representing + ! a cube of height "height" + ! and of based on the three points + ! a face is a group of 3 or mode points. + [ dup dup 3points-to-normal ] dip + v*n [ v+ ] curry map ! 2 eme face triangulaire + 2-faces-to-prism + +! [ dup number? [ 1 + ] when ] deep-map +! dup keep +; + + +: Xpoints-to-plane4D ( seq x y -- 4Dplane ) + ! from 3 points gives a list of faces representing + ! a cube in 4th dim + ! from x to y (height = y-x) + ! and of based on the X points + ! a face is a group of 3 or mode points. + '[ [ [ _ suffix ] map ] [ [ _ suffix ] map ] bi ] call + 2-faces-to-prism +; + +: 3pointsfaces-to-3Dsolidfaces ( seq -- seq ) + [ 1 Xpoints-to-prisme [ 100 + 110 Xpoints-to-plane4D ] map concat ] map + +; + +: test-figure ( -- solid ) + + 2 >>dimension + { 1 -1 -5 } cut-solid + { -1 -1 -21 } cut-solid + { -1 0 -12 } cut-solid + { 1 2 16 } cut-solid +; + diff --git a/advice/advice-docs.factor b/advice/advice-docs.factor new file mode 100644 index 0000000..04e2f85 --- /dev/null +++ b/advice/advice-docs.factor @@ -0,0 +1,27 @@ +IN: advice +USING: help.markup help.syntax tools.annotations words coroutines ; + +HELP: make-advised +{ $values { "word" "a word to annotate in preparation of advising" } } +{ $description "Prepares a word for being advised. This is done by: " + { $list + { "Annotating it to call the appropriate words before, around, and after the original body " } + { "Adding " { $snippet "before" } ", " { $snippet "around" } ", and " { $snippet "after" } " properties, which will contain the advice" } + { "Adding an " { $snippet "advised" } "property, which can later be used to determine if a given word is defined (see " { $link advised? } ")" } + } +} +{ $see-also advised? annotate } ; + +HELP: advised? +{ $values { "word" "a word" } { "?" "t or f, indicating if " { $snippet "word" } " is advised" } } +{ $description "Determines whether or not the given word has any advice on it." } ; + +HELP: ad-do-it +{ $values { "input" "an object" } { "result" "an object" } } +{ $description "Calls either the next applicable around advice or the main body, returning back to the point it was called from when finished. This word should only be called from inside advice." } +{ $see-also coyield } ; + +ARTICLE: "advice" "Advice" +"Advice is a simple way of adding additition functionality to words by adding 'hooks' to a word, which can act before, after, or around the calling of the word." ; + +ABOUT: "advice" diff --git a/advice/advice-tests.factor b/advice/advice-tests.factor new file mode 100644 index 0000000..396687e --- /dev/null +++ b/advice/advice-tests.factor @@ -0,0 +1,94 @@ +! Copyright (C) 2008 James Cash +! See http://factorcode.org/license.txt for BSD license. +USING: kernel sequences io io.streams.string math tools.test advice math.parser +parser namespaces multiline eval words assocs ; +IN: advice.tests + +[ + [ ad-do-it ] must-fail + + : foo ( -- str ) "foo" ; + \ foo make-advised + + { "bar" "foo" } [ + [ "bar" ] "barify" \ foo advise-before + foo + ] unit-test + + { "bar" "foo" "baz" } [ + [ "baz" ] "bazify" \ foo advise-after + foo + ] unit-test + + { "foo" "baz" } [ + "barify" \ foo before remove-advice + foo + ] unit-test + + : bar ( a -- b ) 1 + ; + \ bar make-advised + + { 11 } [ + [ 2 * ] "double" \ bar advise-before + 5 bar + ] unit-test + + { 11/3 } [ + [ 3 / ] "third" \ bar advise-after + 5 bar + ] unit-test + + { -2 } [ + [ -1 * ad-do-it 3 + ] "frobnobicate" \ bar advise-around + 5 bar + ] unit-test + + : add ( a b -- c ) + ; + \ add make-advised + + { 10 } [ + [ [ 2 * ] bi@ ] "double-args" \ add advise-before + 2 3 add + ] unit-test + + { 21 } [ + [ 3 * ad-do-it 1- ] "around1" \ add advise-around + 2 3 add + ] unit-test + +! { 9 } [ +! [ [ 1- ] bi@ ad-do-it 2 / ] "around2" \ add advise-around +! 2 3 add +! ] unit-test + +! { { "around1" "around2" } } [ +! \ add around word-prop keys +! ] unit-test + + { 5 f } [ + \ add unadvise + 2 3 add \ add advised? + ] unit-test + +! : quux ( a b -- c ) * ; + +! { f t 3+3/4 } [ +! <" USING: advice kernel math ; +! IN: advice.tests +! \ quux advised? +! ADVISE: quux halve before [ 2 / ] bi@ ; +! \ quux advised? +! 3 5 quux"> eval +! ] unit-test + +! { 3+3/4 "1+1/2 2+1/2 3+3/4" } [ +! <" USING: advice kernel math math.parser io io.streams.string ; +! IN: advice.tests +! ADVISE: quux log around +! 2dup [ number>string write " " write ] bi@ +! ad-do-it +! dup number>string write ; +! [ 3 5 quux ] with-string-writer"> eval +! ] unit-test + +] with-scope diff --git a/advice/advice.factor b/advice/advice.factor new file mode 100644 index 0000000..8e22609 --- /dev/null +++ b/advice/advice.factor @@ -0,0 +1,69 @@ +! Copyright (C) 2008 James Cash +! See http://factorcode.org/license.txt for BSD license. +USING: kernel sequences fry words assocs linked-assocs tools.annotations +coroutines lexer parser quotations arrays namespaces continuations +summary ; +IN: advice + +SYMBOLS: before after around advised in-advice? ; + +: advised? ( word -- ? ) + advised word-prop ; + +DEFER: make-advised + + + +: advise ( quot name word loc -- ) + dup around eq? [ [ init-around-co ] 3dip ] when + over advised? [ over make-advised ] unless + word-prop set-at ; + +: advise-before ( quot name word -- ) before advise ; + +: advise-after ( quot name word -- ) after advise ; + +: advise-around ( quot name word -- ) around advise ; + +: get-advice ( word type -- seq ) + word-prop values ; + +: call-before ( word -- ) + before get-advice [ call ] each ; + +: call-after ( word -- ) + after get-advice [ call ] each ; + +: call-around ( main word -- ) + t in-advice? [ + around get-advice tuck + [ [ coresume ] each ] [ call ] [ [ coresume ] each ] tri* + ] with-variable ; + +: remove-advice ( name word loc -- ) + word-prop delete-at ; + +ERROR: ad-do-it-error ; + +M: ad-do-it-error summary + drop "ad-do-it should only be called inside 'around' advice" ; + +: ad-do-it ( input -- result ) + in-advice? get [ ad-do-it-error ] unless coyield ; + +: make-advised ( word -- ) + [ dup '[ [ _ ] dip over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ] + [ { before after around } [ swap set-word-prop ] with each ] + [ t advised set-word-prop ] tri ; + +: unadvise ( word -- ) + [ reset ] [ { before after around advised } [ f swap set-word-prop ] with each ] bi ; + +SYNTAX: ADVISE: ! word adname location => word adname quot loc + scan-word scan scan-word parse-definition swap [ spin ] dip advise ; + +SYNTAX: UNADVISE: + scan-word suffix! \ unadvise suffix! ; diff --git a/advice/authors.txt b/advice/authors.txt new file mode 100644 index 0000000..4b7af4a --- /dev/null +++ b/advice/authors.txt @@ -0,0 +1 @@ +James Cash diff --git a/advice/summary.txt b/advice/summary.txt new file mode 100644 index 0000000..a6f9c06 --- /dev/null +++ b/advice/summary.txt @@ -0,0 +1 @@ +Implmentation of advice/aspects diff --git a/advice/tags.txt b/advice/tags.txt new file mode 100644 index 0000000..f427429 --- /dev/null +++ b/advice/tags.txt @@ -0,0 +1 @@ +extensions diff --git a/alien/cxx/authors.txt b/alien/cxx/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/cxx/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/cxx/cxx.factor b/alien/cxx/cxx.factor new file mode 100644 index 0000000..a8449b8 --- /dev/null +++ b/alien/cxx/cxx.factor @@ -0,0 +1,34 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.cxx.parser alien.marshall +alien.inline.types classes.mixin classes.tuple kernel namespaces +assocs sequences parser classes.parser alien.marshall.syntax +interpolate locals effects io strings make vocabs.parser words +generic fry quotations ; +IN: alien.cxx + + + +: define-c++-class ( name superclass-mixin -- ) + [ [ class-tuple-word ] [ class-mixin ] bi dup ] dip + add-mixin-instance define-class-tuple ; + +:: define-c++-method ( class-name generic name types effect virtual -- ) + [ name % "_" % class-name H{ { CHAR: : CHAR: _ } } substitute % ] "" make :> name' + effect [ in>> "self" suffix ] [ out>> ] bi :> effect' + types class-name "*" append suffix :> types' + effect in>> "," join :> args + class-name virtual [ "#" append ] unless current-vocab lookup :> class + SBUF" " clone dup [ I[ return self->${name}(${args});]I ] with-output-stream >string :> body + name' types' effect' body define-c-marshalled + class generic create-method name' current-vocab lookup 1quotation define ; diff --git a/alien/cxx/parser/authors.txt b/alien/cxx/parser/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/cxx/parser/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/cxx/parser/parser.factor b/alien/cxx/parser/parser.factor new file mode 100644 index 0000000..5afaab2 --- /dev/null +++ b/alien/cxx/parser/parser.factor @@ -0,0 +1,10 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: parser lexer alien.inline ; +IN: alien.cxx.parser + +: parse-c++-class-definition ( -- class superclass-mixin ) + scan scan-word ; + +: parse-c++-method-definition ( -- class-name generic name types effect ) + scan scan-word function-types-effect ; diff --git a/alien/cxx/syntax/authors.txt b/alien/cxx/syntax/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/cxx/syntax/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/cxx/syntax/syntax-tests.factor b/alien/cxx/syntax/syntax-tests.factor new file mode 100644 index 0000000..b8b0851 --- /dev/null +++ b/alien/cxx/syntax/syntax-tests.factor @@ -0,0 +1,113 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test alien.cxx.syntax alien.inline.syntax +alien.marshall.syntax alien.marshall accessors kernel ; +IN: alien.cxx.syntax.tests + +DELETE-C-LIBRARY: test +C-LIBRARY: test + +COMPILE-AS-C++ + +C-INCLUDE: + +C-TYPEDEF: std::string string + +C++-CLASS: std::string c++-root + +GENERIC: to-string ( obj -- str ) + +C++-METHOD: std::string to-string const-char* c_str ( ) + +CM-FUNCTION: std::string* new_string ( const-char* s ) + return new std::string(s); +; + +;C-LIBRARY + +ALIAS: new_string + +{ 1 1 } [ new_string ] must-infer-as +{ 1 1 } [ c_str_std__string ] must-infer-as +[ t ] [ "abc" std::string? ] unit-test +[ "abc" ] [ "abc" to-string ] unit-test + + +DELETE-C-LIBRARY: inheritance +C-LIBRARY: inheritance + +COMPILE-AS-C++ + +C-INCLUDE: + + + +C++-CLASS: alpha c++-root +C++-CLASS: beta alpha + +CM-FUNCTION: alpha* new_alpha ( const-char* s ) + return new alpha(s); +; + +CM-FUNCTION: beta* new_beta ( const-char* s ) + return new beta(s); +; + +ALIAS: new_alpha +ALIAS: new_beta + +GENERIC: render ( obj -- obj ) +GENERIC: chop ( obj -- obj ) +GENERIC: length ( obj -- n ) + +C++-METHOD: alpha render const-char* render ( ) +C++-METHOD: beta render const-char* render ( ) +C++-VIRTUAL: alpha chop const-char* chop ( ) +C++-VIRTUAL: beta chop const-char* chop ( ) +C++-VIRTUAL: alpha length int length ( ) + +;C-LIBRARY + +{ 1 1 } [ render_alpha ] must-infer-as +{ 1 1 } [ chop_beta ] must-infer-as +{ 1 1 } [ length_alpha ] must-infer-as +[ t ] [ "x" alpha#? ] unit-test +[ t ] [ "x" alpha? ] unit-test +[ t ] [ "x" alpha? ] unit-test +[ f ] [ "x" alpha#? ] unit-test +[ 5 ] [ "hello" length ] unit-test +[ 4 ] [ "hello" length ] unit-test +[ "hello" ] [ "hello" render ] unit-test +[ "llo" ] [ "hello" render ] unit-test +[ "ello" ] [ "hello" underlying>> \ alpha# new swap >>underlying render ] unit-test +[ "hello" ] [ "hello" chop ] unit-test +[ "lo" ] [ "hello" chop ] unit-test +[ "lo" ] [ "hello" underlying>> \ alpha# new swap >>underlying chop ] unit-test diff --git a/alien/cxx/syntax/syntax.factor b/alien/cxx/syntax/syntax.factor new file mode 100644 index 0000000..66c72c1 --- /dev/null +++ b/alien/cxx/syntax/syntax.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.cxx alien.cxx.parser ; +IN: alien.cxx.syntax + +SYNTAX: C++-CLASS: + parse-c++-class-definition define-c++-class ; + +SYNTAX: C++-METHOD: + parse-c++-method-definition f define-c++-method ; + +SYNTAX: C++-VIRTUAL: + parse-c++-method-definition t define-c++-method ; diff --git a/alien/inline/authors.txt b/alien/inline/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/inline/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/inline/compiler/authors.txt b/alien/inline/compiler/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/inline/compiler/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/inline/compiler/compiler-docs.factor b/alien/inline/compiler/compiler-docs.factor new file mode 100644 index 0000000..a5c204c --- /dev/null +++ b/alien/inline/compiler/compiler-docs.factor @@ -0,0 +1,78 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel strings words.symbol sequences ; +IN: alien.inline.compiler + +HELP: C +{ $var-description "A symbol representing C source." } ; + +HELP: C++ +{ $var-description "A symbol representing C++ source." } ; + +HELP: compile-to-library +{ $values + { "lang" symbol } { "args" sequence } { "contents" string } { "name" string } +} +{ $description "Compiles and links " { $snippet "contents" } " into a shared library called " { $snippet "libname.suffix" } + "in " { $snippet "resource:alien-inline-libs" } ". " { $snippet "suffix" } " is OS specific. " + { $snippet "args" } " is a sequence of arguments for the linking stage." } +{ $notes + { $list + "C and C++ are the only supported languages." + { "Source and object files are placed in " { $snippet "resource:temp" } "." } } +} ; + +HELP: compiler +{ $values + { "lang" symbol } + { "str" string } +} +{ $description "Returns a compiler name based on OS and source language." } +{ $see-also compiler-descr } ; + +HELP: compiler-descr +{ $values + { "lang" symbol } + { "descr" "a process description" } +} +{ $description "Returns a compiler process description based on OS and source language." } +{ $see-also compiler } ; + +HELP: inline-library-file +{ $values + { "name" string } + { "path" "a pathname string" } +} +{ $description "Appends " { $snippet "name" } " to the " { $link inline-libs-directory } "." } ; + +HELP: inline-libs-directory +{ $values + { "path" "a pathname string" } +} +{ $description "The directory where libraries created using " { $snippet "alien.inline" } " are stored." } ; + +HELP: library-path +{ $values + { "str" string } + { "path" "a pathname string" } +} +{ $description "Converts " { $snippet "name" } " into a full path to the corresponding inline library." } ; + +HELP: library-suffix +{ $values + { "str" string } +} +{ $description "The appropriate shared library suffix for the current OS." } ; + +HELP: link-descr +{ $values + { "lang" "a language" } + { "descr" sequence } +} +{ $description "Returns part of a process description. OS dependent." } ; + +ARTICLE: "alien.inline.compiler" "Inline C compiler" +{ $vocab-link "alien.inline.compiler" } +; + +ABOUT: "alien.inline.compiler" diff --git a/alien/inline/compiler/compiler.factor b/alien/inline/compiler/compiler.factor new file mode 100644 index 0000000..4f9515c --- /dev/null +++ b/alien/inline/compiler/compiler.factor @@ -0,0 +1,93 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays combinators fry generalizations +io.encodings.ascii io.files io.files.temp io.launcher kernel +locals make sequences system vocabs.parser words io.directories +io.pathnames ; +IN: alien.inline.compiler + +SYMBOL: C +SYMBOL: C++ + +: inline-libs-directory ( -- path ) + "alien-inline-libs" resource-path dup make-directories ; + +: inline-library-file ( name -- path ) + inline-libs-directory prepend-path ; + +: library-suffix ( -- str ) + os { + { [ dup macosx? ] [ drop ".dylib" ] } + { [ dup unix? ] [ drop ".so" ] } + { [ dup windows? ] [ drop ".dll" ] } + } cond ; + +: library-path ( str -- path ) + '[ "lib" % _ % library-suffix % ] "" make inline-library-file ; + +HOOK: compiler os ( lang -- str ) + +M: word compiler + { + { C [ "gcc" ] } + { C++ [ "g++" ] } + } case ; + +M: openbsd compiler + { + { C [ "gcc" ] } + { C++ [ "eg++" ] } + } case ; + +M: windows compiler + { + { C [ "gcc" ] } + { C++ [ "g++" ] } + } case ; + +HOOK: compiler-descr os ( lang -- descr ) + +M: word compiler-descr compiler 1array ; +M: macosx compiler-descr + call-next-method cpu x86.64? + [ { "-arch" "x86_64" } append ] when ; + +HOOK: link-descr os ( lang -- descr ) + +M: word link-descr drop { "-shared" "-o" } ; +M: macosx link-descr + drop { "-g" "-prebind" "-dynamiclib" "-o" } + cpu x86.64? [ { "-arch" "x86_64" } prepend ] when ; +M: windows link-descr + { + { C [ { "-mno-cygwin" "-shared" "-o" } ] } + { C++ [ { "-lstdc++" "-mno-cygwin" "-shared" "-o" } ] } + } case ; + + + +:: compile-to-library ( lang args contents name -- ) + lang contents name compile-to-object + lang args name link-object ; diff --git a/alien/inline/inline-docs.factor b/alien/inline/inline-docs.factor new file mode 100644 index 0000000..2c0cd28 --- /dev/null +++ b/alien/inline/inline-docs.factor @@ -0,0 +1,113 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel strings effects quotations ; +IN: alien.inline + + + +HELP: compile-c-library +{ $description "Writes, compiles, and links code generated since last invocation of " { $link POSTPONE: define-c-library } ". " + "Also calls " { $snippet "add-library" } ". " + "This word does nothing if the shared library is younger than the factor source file." } +{ $notes $binding-note } ; + +HELP: c-use-framework +{ $values + { "str" string } +} +{ $description "OS X only. Adds " { $snippet "-framework name" } " to linker command." } +{ $notes $binding-note } +{ $see-also c-link-to c-link-to/use-framework } ; + +HELP: define-c-function +{ $values + { "function" "function name" } { "types" "a sequence of C types" } { "effect" effect } { "body" string } +} +{ $description "Defines a C function and a factor word which calls it." } +{ $notes + { $list + { "The number of " { $snippet "types" } " must match the " { $snippet "in" } " count of the " { $snippet "effect" } "." } + { "There must be only one " { $snippet "out" } " element. It must be a legal C return type with dashes (-) instead of spaces." } + $binding-note + } +} +{ $see-also POSTPONE: define-c-function' } ; + +HELP: define-c-function' +{ $values + { "function" "function name" } { "effect" effect } { "body" string } +} +{ $description "Defines a C function and a factor word which calls it. See " { $link define-c-function } " for more information." } +{ $notes + { $list + { "Each effect element must be a legal C type with dashes (-) instead of spaces. " + "C argument names will be generated alphabetically, starting with " { $snippet "a" } "." } + $binding-note + } +} +{ $see-also define-c-function } ; + +HELP: c-include +{ $values + { "str" string } +} +{ $description "Appends an include line to the C library in scope." } +{ $notes $binding-note } ; + +HELP: define-c-library +{ $values + { "name" string } +} +{ $description "Starts a new C library scope. Other " { $snippet "alien.inline" } " words can be used after this one." } ; + +HELP: c-link-to +{ $values + { "str" string } +} +{ $description "Adds " { $snippet "-lname" } " to linker command." } +{ $notes $binding-note } +{ $see-also c-use-framework c-link-to/use-framework } ; + +HELP: c-link-to/use-framework +{ $values + { "str" string } +} +{ $description "Equivalent to " { $link c-use-framework } " on OS X and " { $link c-link-to } " everywhere else." } +{ $notes $binding-note } +{ $see-also c-link-to c-use-framework } ; + +HELP: define-c-struct +{ $values + { "name" string } { "fields" "type/name pairs" } +} +{ $description "Defines a C struct and factor words which operate on it." } +{ $notes $binding-note } ; + +HELP: define-c-typedef +{ $values + { "old" "C type" } { "new" "C type" } +} +{ $description "Define C and factor typedefs." } +{ $notes $binding-note } ; + +HELP: delete-inline-library +{ $values + { "name" string } +} +{ $description "Delete the shared library file corresponding to " { $snippet "name" } "." } +{ $notes "Must be executed in the vocabulary where " { $snippet "name" } " is defined. " } ; + +HELP: with-c-library +{ $values + { "name" string } { "quot" quotation } +} +{ $description "Calls " { $link define-c-library } ", then the quotation, then " { $link compile-c-library } ", then sets all variables bound by " { $snippet "define-c-library" } " to " { $snippet "f" } "." } ; + +HELP: raw-c +{ $values { "str" string } } +{ $description "Insert a string into the generated source file. Useful for macros and other details not implemented in " { $snippet "alien.inline" } "." } ; diff --git a/alien/inline/inline.factor b/alien/inline/inline.factor new file mode 100644 index 0000000..b40bc8c --- /dev/null +++ b/alien/inline/inline.factor @@ -0,0 +1,131 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.inline.compiler alien.inline.types +alien.libraries alien.parser arrays assocs effects fry +generalizations grouping io.directories io.files +io.files.info io.files.temp kernel lexer math math.order +math.ranges multiline namespaces sequences source-files +splitting strings system vocabs.loader vocabs.parser words +alien.c-types alien.structs make parser continuations ; +IN: alien.inline + +SYMBOL: c-library +SYMBOL: library-is-c++ +SYMBOL: linker-args +SYMBOL: c-strings + +> + [ file-info modified>> ] bi@ <=> +lt+ = + ] [ drop t ] if* + ] [ drop t ] if ; + +: compile-library ( -- ) + library-is-c++ get [ C++ ] [ C ] if + linker-args get + c-strings get "\n" join + c-library get compile-to-library ; + +: c-library-name ( name -- name' ) + [ current-vocab name>> % "_" % % ] "" make ; +PRIVATE> + +: parse-arglist ( parameters return -- types effect ) + [ 2 group unzip [ "," ?tail drop ] map ] + [ [ { } ] [ 1array ] if-void ] + bi* ; + +: append-function-body ( prototype-str body -- str ) + [ swap % " {\n" % % "\n}\n" % ] "" make ; + +: function-types-effect ( -- function types effect ) + scan scan swap ")" parse-tokens + [ "(" subseq? ] reject swap parse-arglist ; + +: prototype-string ( function types effect -- str ) + [ [ cify-type ] map ] dip + types-effect>params-return cify-type -rot + [ " " join ] map ", " join + "(" prepend ")" append 3array " " join + library-is-c++ get [ "extern \"C\" " prepend ] when ; + +: prototype-string' ( function types return -- str ) + [ dup arg-list ] prototype-string ; + +: factor-function ( function types effect -- word quot effect ) + annotate-effect [ c-library get ] 3dip + [ [ factorize-type ] map ] dip + types-effect>params-return factorize-type -roll + concat make-function ; + +: define-c-library ( name -- ) + c-library-name [ c-library set ] [ "c-library" set ] bi + V{ } clone c-strings set + V{ } clone linker-args set ; + +: compile-c-library ( -- ) + compile-library? [ compile-library ] when + c-library get dup library-path cdecl add-library ; + +: define-c-function ( function types effect body -- ) + [ + [ factor-function define-declared ] + [ prototype-string ] 3bi + ] dip append-function-body c-strings get push ; + +: define-c-function' ( function effect body -- ) + [ + [ in>> ] keep + [ factor-function define-declared ] + [ out>> prototype-string' ] 3bi + ] dip append-function-body c-strings get push ; + +: c-link-to ( str -- ) + "-l" prepend linker-args get push ; + +: c-use-framework ( str -- ) + "-framework" swap linker-args get '[ _ push ] bi@ ; + +: c-link-to/use-framework ( str -- ) + os macosx? [ c-use-framework ] [ c-link-to ] if ; + +: c-include ( str -- ) + "#include " prepend c-strings get push ; + +: define-c-typedef ( old new -- ) + [ typedef ] [ + [ swap "typedef " % % " " % % ";" % ] + "" make c-strings get push + ] 2bi ; + +: define-c-struct ( name fields -- ) + [ current-vocab swap define-struct ] [ + over + [ + "typedef struct " % "_" % % " {\n" % + [ first2 swap % " " % % ";\n" % ] each + "} " % % ";\n" % + ] "" make c-strings get push + ] 2bi ; + +: delete-inline-library ( name -- ) + c-library-name [ remove-library ] + [ library-path dup exists? [ delete-file ] [ drop ] if ] bi ; + +: with-c-library ( name quot -- ) + [ [ define-c-library ] dip call compile-c-library ] + [ cleanup-variables ] [ ] cleanup ; inline + +: raw-c ( str -- ) + [ "\n" % % "\n" % ] "" make c-strings get push ; diff --git a/alien/inline/syntax/authors.txt b/alien/inline/syntax/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/inline/syntax/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/inline/syntax/syntax-docs.factor b/alien/inline/syntax/syntax-docs.factor new file mode 100644 index 0000000..844cb1d --- /dev/null +++ b/alien/inline/syntax/syntax-docs.factor @@ -0,0 +1,100 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax alien.inline ; +IN: alien.inline.syntax + +HELP: ;C-LIBRARY +{ $syntax ";C-LIBRARY" } +{ $description "Writes, compiles, and links code generated since previous invocation of " { $link POSTPONE: C-LIBRARY: } "." } +{ $see-also POSTPONE: compile-c-library } ; + +HELP: C-FRAMEWORK: +{ $syntax "C-FRAMEWORK: name" } +{ $description "OS X only. Link to named framework. Takes effect when " { $link POSTPONE: ;C-LIBRARY } " is called." } +{ $see-also POSTPONE: c-use-framework } ; + +HELP: C-FUNCTION: +{ $syntax "C-FUNCTION: return name ( args ... )\nbody\n;" } +{ $description "Appends a function to the C library in scope and defines an FFI word that calls it." } +{ $examples + { $example + "USING: alien.inline.syntax prettyprint ;" + "IN: cmath.ffi" + "" + "C-LIBRARY: cmathlib" + "" + "C-FUNCTION: int add ( int a, int b )" + " return a + b;" + ";" + "" + ";C-LIBRARY" + "" + "1 2 add ." + "3" } +} +{ $see-also POSTPONE: define-c-function } ; + +HELP: C-INCLUDE: +{ $syntax "C-INCLUDE: name" } +{ $description "Appends an include line to the C library in scope." } +{ $see-also POSTPONE: c-include } ; + +HELP: C-LIBRARY: +{ $syntax "C-LIBRARY: name" } +{ $description "Starts a new C library scope. Other " { $snippet "alien.inline" } " syntax can be used after this word." } +{ $examples + { $example + "USING: alien.inline.syntax ;" + "IN: rectangle.ffi" + "" + "C-LIBRARY: rectlib" + "" + "C-STRUCTURE: rectangle { \"int\" \"width\" } { \"int\" \"height\" } ;" + "" + "C-FUNCTION: int area ( rectangle c )" + " return c.width * c.height;" + ";" + "" + ";C-LIBRARY" + "" } +} +{ $see-also POSTPONE: define-c-library } ; + +HELP: C-LINK/FRAMEWORK: +{ $syntax "C-LINK/FRAMEWORK: name" } +{ $description "Equivalent to " { $link POSTPONE: C-FRAMEWORK: } " on OS X and " { $link POSTPONE: C-LINK: } " everywhere else." } +{ $see-also POSTPONE: c-link-to/use-framework } ; + +HELP: C-LINK: +{ $syntax "C-LINK: name" } +{ $description "Link to named library. Takes effect when " { $link POSTPONE: ;C-LIBRARY } " is called." } +{ $see-also POSTPONE: c-link-to } ; + +HELP: C-STRUCTURE: +{ $syntax "C-STRUCTURE: name pairs ... ;" } +{ $description "Like " { $snippet "C-STRUCT:" } " but also generates equivalent C code."} +{ $see-also POSTPONE: define-c-struct } ; + +HELP: C-TYPEDEF: +{ $syntax "C-TYPEDEF: old new" } +{ $description "Like " { $snippet "TYPEDEF:" } " but generates a C typedef statement too." } +{ $see-also POSTPONE: define-c-typedef } ; + +HELP: COMPILE-AS-C++ +{ $syntax "COMPILE-AS-C++" } +{ $description "Insert this word anywhere between " { $link POSTPONE: C-LIBRARY: } " and " { $link POSTPONE: ;C-LIBRARY } " and the generated code will be treated as C++ with " { $snippet "extern \"C\"" } " prepended to each function prototype." } ; + +HELP: DELETE-C-LIBRARY: +{ $syntax "DELETE-C-LIBRARY: name" } +{ $description "Deletes the shared library file corresponding to " { $snippet "name" } " . " } +{ $notes + { $list + { "Must be executed in the vocabulary where " { $snippet "name" } " is defined. " } + "This word is mainly useful for unit tests." + } +} +{ $see-also POSTPONE: delete-inline-library } ; + +HELP: " } +{ $description "Insert a (multiline) string into the generated source file. Useful for macros and other details not implemented in " { $snippet "alien.inline" } "." } ; diff --git a/alien/inline/syntax/syntax-tests.factor b/alien/inline/syntax/syntax-tests.factor new file mode 100644 index 0000000..4044e16 --- /dev/null +++ b/alien/inline/syntax/syntax-tests.factor @@ -0,0 +1,72 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.inline alien.inline.syntax io.directories io.files +kernel namespaces tools.test alien.c-types alien.data alien.structs ; +IN: alien.inline.syntax.tests + +DELETE-C-LIBRARY: test +C-LIBRARY: test + +C-FUNCTION: const-int add ( int a, int b ) + return a + b; +; + +C-TYPEDEF: double bigfloat + +C-FUNCTION: bigfloat smaller ( bigfloat a ) + return a / 10; +; + +C-STRUCTURE: rectangle + { "int" "width" } + { "int" "height" } ; + +C-FUNCTION: int area ( rectangle c ) + return c.width * c.height; +; + +;C-LIBRARY + +{ 2 1 } [ add ] must-infer-as +[ 5 ] [ 2 3 add ] unit-test + +[ t ] [ "double" "bigfloat" [ resolve-typedef ] same? ] unit-test +{ 1 1 } [ smaller ] must-infer-as +[ 1.0 ] [ 10 smaller ] unit-test + +[ t ] [ "rectangle" resolve-typedef struct-type? ] unit-test +{ 1 1 } [ area ] must-infer-as +[ 20 ] [ + "rectangle" + 4 over set-rectangle-width + 5 over set-rectangle-height + area +] unit-test + + +DELETE-C-LIBRARY: cpplib +C-LIBRARY: cpplib + +COMPILE-AS-C++ + +C-INCLUDE: + +C-FUNCTION: const-char* hello ( ) + std::string s("hello world"); + return s.c_str(); +; + +;C-LIBRARY + +{ 0 1 } [ hello ] must-infer-as +[ "hello world" ] [ hello ] unit-test + + +DELETE-C-LIBRARY: compile-error +C-LIBRARY: compile-error + +C-FUNCTION: char* breakme ( ) + return not a string; +; + +<< [ compile-c-library ] must-fail >> diff --git a/alien/inline/syntax/syntax.factor b/alien/inline/syntax/syntax.factor new file mode 100644 index 0000000..ce18616 --- /dev/null +++ b/alien/inline/syntax/syntax.factor @@ -0,0 +1,31 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.inline lexer multiline namespaces parser ; +IN: alien.inline.syntax + + +SYNTAX: C-LIBRARY: scan define-c-library ; + +SYNTAX: COMPILE-AS-C++ t library-is-c++ set ; + +SYNTAX: C-LINK: scan c-link-to ; + +SYNTAX: C-FRAMEWORK: scan c-use-framework ; + +SYNTAX: C-LINK/FRAMEWORK: scan c-link-to/use-framework ; + +SYNTAX: C-INCLUDE: scan c-include ; + +SYNTAX: C-FUNCTION: + function-types-effect parse-here define-c-function ; + +SYNTAX: C-TYPEDEF: scan scan define-c-typedef ; + +SYNTAX: C-STRUCTURE: + scan parse-definition define-c-struct ; + +SYNTAX: ;C-LIBRARY compile-c-library ; + +SYNTAX: DELETE-C-LIBRARY: scan delete-inline-library ; + +SYNTAX: " parse-multiline-string raw-c ; diff --git a/alien/inline/types/authors.txt b/alien/inline/types/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/inline/types/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/inline/types/types.factor b/alien/inline/types/types.factor new file mode 100644 index 0000000..fe4e31f --- /dev/null +++ b/alien/inline/types/types.factor @@ -0,0 +1,102 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types assocs combinators.short-circuit +continuations effects fry kernel math memoize sequences +splitting strings peg.ebnf make words ; +IN: alien.inline.types + +: cify-type ( str -- str' ) + dup word? [ name>> ] when + H{ { CHAR: - CHAR: space } } substitute ; + +: factorize-type ( str -- str' ) + cify-type + "const " ?head drop + "unsigned " ?head [ "u" prepend ] when + "long " ?head [ "long" prepend ] when + " const" ?tail drop ; + +: const-pointer? ( str -- ? ) + cify-type { [ " const" tail? ] [ "&" tail? ] } 1|| ; + +: pointer-to-const? ( str -- ? ) + cify-type "const " head? ; + +: template-class? ( str -- ? ) + [ CHAR: < = ] any? ; + +MEMO: resolved-primitives ( -- seq ) + primitive-types [ resolve-typedef ] map ; + +: primitive-type? ( type -- ? ) + [ + factorize-type resolve-typedef [ resolved-primitives ] dip + '[ _ = ] any? + ] [ 2drop f ] recover ; + +: pointer? ( type -- ? ) + factorize-type [ "*" tail? ] [ "&" tail? ] bi or ; + +: type-sans-pointer ( type -- type' ) + factorize-type [ '[ _ = ] "*&" swap any? ] trim-tail ; + +: pointer-to-primitive? ( type -- ? ) + factorize-type + { [ pointer? ] [ type-sans-pointer primitive-type? ] } 1&& ; + +: pointer-to-non-const-primitive? ( str -- ? ) + { + [ pointer-to-const? not ] + [ factorize-type pointer-to-primitive? ] + } 1&& ; + +: types-effect>params-return ( types effect -- params return ) + [ in>> zip ] + [ nip out>> dup length 0 > [ first ] [ drop "void" ] if ] + 2bi ; + +: annotate-effect ( types effect -- types effect' ) + [ in>> ] [ out>> ] bi [ + zip + [ over pointer-to-primitive? [ ">" prepend ] when ] + assoc-map unzip + ] dip ; + +TUPLE: c++-type name params ptr ; +C: c++-type + +EBNF: (parse-c++-type) +dig = [0-9] +alpha = [a-zA-Z] +alphanum = [1-9a-zA-Z] +name = [_a-zA-Z] [_a-zA-Z1-9:]* => [[ first2 swap prefix >string ]] +ptr = [*&] => [[ empty? not ]] + +param = "," " "* type " "* => [[ third ]] + +params = "<" " "* type " "* param* ">" => [[ [ 4 swap nth ] [ third ] bi prefix ]] + +type = name " "* params? " "* ptr? => [[ { 0 2 4 } [ swap nth ] with map first3 ]] +;EBNF + +: parse-c++-type ( str -- c++-type ) + factorize-type (parse-c++-type) ; + +DEFER: c++-type>string + +: params>string ( params -- str ) + [ "<" % [ c++-type>string ] map "," join % ">" % ] "" make ; + +: c++-type>string ( c++-type -- str ) + [ + [ name>> % ] + [ params>> [ params>string % ] when* ] + [ ptr>> [ "*" % ] when ] + tri + ] "" make ; + +GENERIC: c++-type ( obj -- c++-type/f ) + +M: object c++-type drop f ; + +M: c++-type c-type ; diff --git a/alien/marshall/authors.txt b/alien/marshall/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/marshall/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/marshall/marshall-docs.factor b/alien/marshall/marshall-docs.factor new file mode 100644 index 0000000..519fe99 --- /dev/null +++ b/alien/marshall/marshall-docs.factor @@ -0,0 +1,638 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations sequences +strings alien alien.c-types alien.data math byte-arrays ; +IN: alien.marshall + + + +HELP: ?malloc-byte-array +{ $values + { "c-type" c-type } + { "alien" alien } +} +{ $description "Does nothing if input is an alien, otherwise assumes it is a byte array and calls " + { $snippet "malloc-byte-array" } "." +} +{ $notes $memory-note } ; + +HELP: alien-wrapper +{ $var-description "For wrapping C pointers in a structure factor can dispatch on." } ; + +HELP: unmarshall-cast +{ $values + { "alien-wrapper" alien-wrapper } + { "alien-wrapper'" alien-wrapper } +} +{ $description "Called immediately after unmarshalling. Useful for automatically casting to subtypes." } ; + +HELP: marshall-bool +{ $values + { "?" "a generalized boolean" } + { "n" "0 or 1" } +} +{ $description "Marshalls objects to bool." } +{ $notes "Will treat " { $snippet "0" } " as " { $snippet "t" } "." } ; + +HELP: marshall-bool* +{ $values + { "?/seq" "t/f or sequence" } + { "alien" alien } +} +{ $description "When the argument is a sequence, returns a pointer to an array of bool, " + "otherwise returns a pointer to a single bool value." +} +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-bool** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description "Takes a one or two dimensional array of generalized booleans " + "and returns a pointer to the equivalent C structure." +} +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-primitive +{ $values + { "n" number } + { "n" number } +} +{ $description "Marshall numbers to C primitives." + $nl + "Factor marshalls numbers to primitives for FFI calls, so all " + "this word does is convert " { $snippet "t" } " to " { $snippet "1" } + ", " { $snippet "f" } " to " { $snippet "0" } ", and lets anything else " + "pass through untouched." +} ; + +HELP: marshall-char* +{ $values + { "n/seq" "number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-char** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-char**-or-strings +{ $values + { "seq" "a sequence of strings" } + { "alien" alien } +} +{ $description "Marshalls an array of strings or characters to an array of C strings." } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-char*-or-string +{ $values + { "n/string" "a number or string" } + { "alien" alien } +} +{ $description "Marshalls a string to a C string or a number to a pointer to " { $snippet "char" } "." } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-double* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-double** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-float* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-float** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-int* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-int** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-long* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-long** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-longlong* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-longlong** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-non-pointer +{ $values + { "alien-wrapper/byte-array" "an alien-wrapper or byte-array" } + { "byte-array" byte-array } +} +{ $description "Converts argument to a byte array." } +{ $notes "Not meant to be called directly. Use the output of " { $link marshaller } " instead." } ; + +HELP: marshall-pointer +{ $values + { "obj" object } + { "alien" alien } +} +{ $description "Converts argument to a C pointer." } +{ $notes "Can marshall the following types: " { $snippet "alien, f, byte-array, alien-wrapper, struct-array" } "." } ; + +HELP: marshall-short* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-short** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-uchar* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-uchar** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-uint* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-uint** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-ulong* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-ulong** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-ulonglong* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-ulonglong** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-ushort* +{ $values + { "n/seq" "a number or sequence" } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-ushort** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description $see-article } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshall-void** +{ $values + { "seq" sequence } + { "alien" alien } +} +{ $description "Marshalls a sequence of objects to an array of pointers to void." } +{ $notes { $list $c-ptr-note $memory-note } } ; + +HELP: marshaller +{ $values + { "type" "a C type string" } + { "quot" quotation } +} +{ $description "Given a C type, returns a quotation that will marshall its argument to that type." } ; + +HELP: out-arg-unmarshaller +{ $values + { "type" "a C type string" } + { "quot" quotation } +} +{ $description "Like " { $link unmarshaller } " but returns an empty quotation " + "for all types except pointers to non-const primitives." +} ; + +HELP: class-unmarshaller +{ $values + { "type" " a C type string" } + { "quot/f" quotation } +} +{ $description "If in the vocab in which this word is called, there is a subclass of " { $link alien-wrapper } + " named after the type argument, " { $snippet "pointer-unmarshaller" } " will return a quotation which " + "wraps its argument in an instance of that subclass. In any other case it returns an empty quotation." +} +{ $notes "Not meant to be called directly. Use the output of " { $link marshaller } " instead." } ; + +HELP: primitive-marshaller +{ $values + { "type" "a C type string" } + { "quot/f" "a quotation or f" } +} +{ $description "Returns a quotation to marshall objects to the argument type." } +{ $notes "Not meant to be called directly. Use the output of " { $link marshaller } " instead." } ; + +HELP: primitive-unmarshaller +{ $values + { "type" "a C type string" } + { "quot/f" "a quotation or f" } +} +{ $description "Returns a quotation to unmarshall objects from the argument type." } +{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ; + +HELP: struct-field-unmarshaller +{ $values + { "type" "a C type string" } + { "quot" quotation } +} +{ $description "Like " { $link unmarshaller } " but returns a quotation that " + "does not call " { $snippet "free" } " on its argument." +} +{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ; + +HELP: struct-primitive-unmarshaller +{ $values + { "type" "a C type string" } + { "quot/f" "a quotation or f" } +} +{ $description "Like " { $link primitive-unmarshaller } " but returns a quotation that " + "does not call " { $snippet "free" } " on its argument." } +{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ; + +HELP: struct-unmarshaller +{ $values + { "type" "a C type string" } + { "quot/f" quotation } +} +{ $description "Returns a quotation which wraps its argument in the subclass of " + { $link struct-wrapper } " which matches the " { $snippet "type" } " arg." +} +{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ; + +HELP: struct-wrapper +{ $var-description "For wrapping C structs in a structure factor can dispatch on." } ; + +HELP: unmarshall-bool +{ $values + { "n" number } + { "?" boolean } +} +{ $description "Unmarshalls a number to a boolean." } ; + +HELP: unmarshall-bool* +{ $values + { "alien" alien } + { "?" boolean } +} +{ $description "Unmarshalls a C pointer to a boolean." } ; + +HELP: unmarshall-bool*-free +{ $values + { "alien" alien } + { "?" boolean } +} +{ $description "Unmarshalls a C pointer to a boolean and frees the pointer." } ; + +HELP: unmarshall-char* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-char*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-char*-to-string +{ $values + { "alien" alien } + { "string" string } +} +{ $description "Unmarshalls a " { $snippet "char" } " pointer to a factor string." } ; + +HELP: unmarshall-char*-to-string-free +{ $values + { "alien" alien } + { "string" string } +} +{ $description "Unmarshalls a " { $snippet "char" } " pointer to a factor string and frees the pointer." } ; + +HELP: unmarshall-double* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-double*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-float* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-float*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-int* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-int*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-long* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-long*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-longlong* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-longlong*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-short* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-short*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-uchar* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-uchar*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-uint* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-uint*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-ulong* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-ulong*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-ulonglong* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-ulonglong*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-ushort* +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshall-ushort*-free +{ $values + { "alien" alien } + { "n" number } +} +{ $description $see-article } ; + +HELP: unmarshaller +{ $values + { "type" "a C type string" } + { "quot" quotation } +} +{ $description "Given a C type, returns a quotation that will unmarshall values of that type." } ; + +ARTICLE: "alien.marshall" "C marshalling" +{ $vocab-link "alien.marshall" } " provides alien wrappers and marshalling words for the " +"automatic marshalling and unmarshalling of C function arguments, return values, and output parameters." + +{ $subheading "Important words" } +"Wrap an alien:" { $subsections alien-wrapper } +"Wrap a struct:" { $subsections struct-wrapper } +"Get the marshaller for a C type:" { $subsections marshaller } +"Get the unmarshaller for a C type:" { $subsections unmarshaller } +"Get the unmarshaller for an output parameter:" { $subsections out-arg-unmarshaller } +"Get the unmarshaller for a struct field:" { $subsections struct-field-unmarshaller } +$nl +"Other marshalling and unmarshalling words in this vocabulary are not intended to be " +"invoked directly." +$nl +"Most marshalling words allow non false c-ptrs to pass through unchanged." + +{ $subheading "Primitive marshallers" } +{ $subsections marshall-primitive } "for marshalling primitive values." +{ $subsections marshall-int* } + "marshalls a number or sequence of numbers. If argument is a sequence, returns a pointer " + "to a C array, otherwise returns a pointer to a single value." +{ $subsections marshall-int** } +"marshalls a 1D or 2D array of numbers. Returns an array of pointers to arrays." + +{ $subheading "Primitive unmarshallers" } +{ $snippet "unmarshall-*" } " and " { $snippet "unmarshall-*-free" } +" for all values of " { $snippet "" } " in " { $link primitive-types } "." +{ $subsections unmarshall-int* } +"unmarshalls a pointer to primitive. Returns a number. " +"Assumes the pointer is not an array (if it is, only the first value is returned). " +"C functions that return arrays are not handled correctly by " { $snippet "alien.marshall" } +" and must be unmarshalled by hand." +{ $subsections unmarshall-int*-free } +"unmarshalls a pointer to primitive, and then frees the pointer." +$nl +"Primitive values require no unmarshalling. The factor FFI already does this." +; + +ABOUT: "alien.marshall" diff --git a/alien/marshall/marshall.factor b/alien/marshall/marshall.factor new file mode 100644 index 0000000..059ee72 --- /dev/null +++ b/alien/marshall/marshall.factor @@ -0,0 +1,326 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien alien.c-types alien.inline.types +alien.marshall.private alien.strings byte-arrays classes +combinators combinators.short-circuit destructors fry +io.encodings.utf8 kernel libc sequences alien.data +specialized-arrays strings unix.utilities vocabs.parser +words libc.private locals generalizations math ; +FROM: alien.c-types => float short ; +SPECIALIZED-ARRAY: bool +SPECIALIZED-ARRAY: char +SPECIALIZED-ARRAY: double +SPECIALIZED-ARRAY: float +SPECIALIZED-ARRAY: int +SPECIALIZED-ARRAY: long +SPECIALIZED-ARRAY: longlong +SPECIALIZED-ARRAY: short +SPECIALIZED-ARRAY: uchar +SPECIALIZED-ARRAY: uint +SPECIALIZED-ARRAY: ulong +SPECIALIZED-ARRAY: ulonglong +SPECIALIZED-ARRAY: ushort +SPECIALIZED-ARRAY: void* +IN: alien.marshall + +<< primitive-types [ [ void* = ] [ bool = ] bi or not ] +filter [ define-primitive-marshallers ] each >> + +TUPLE: alien-wrapper { underlying alien } ; +TUPLE: struct-wrapper < alien-wrapper disposed ; +TUPLE: class-wrapper < alien-wrapper disposed ; + +MIXIN: c++-root + +GENERIC: unmarshall-cast ( alien-wrapper -- alien-wrapper' ) + +M: alien-wrapper unmarshall-cast ; +M: struct-wrapper unmarshall-cast ; + +M: struct-wrapper dispose* underlying>> free ; + +M: class-wrapper c++-type class name>> parse-c++-type ; + +: marshall-pointer ( obj -- alien ) + { + { [ dup alien? ] [ ] } + { [ dup not ] [ ] } + { [ dup byte-array? ] [ malloc-byte-array ] } + { [ dup alien-wrapper? ] [ underlying>> ] } + } cond ; + +: marshall-primitive ( n -- n ) + [ bool>arg ] ptr-pass-through ; + +ALIAS: marshall-void* marshall-pointer + +: marshall-void** ( seq -- alien ) + [ marshall-void* ] void*-array{ } map-as malloc-underlying ; + +: (marshall-char*-or-string) ( n/string -- alien ) + dup string? + [ utf8 string>alien malloc-byte-array ] + [ (marshall-char*) ] if ; + +: marshall-char*-or-string ( n/string -- alien ) + [ (marshall-char*-or-string) ] ptr-pass-through ; + +: (marshall-char**-or-strings) ( seq -- alien ) + [ marshall-char*-or-string ] void*-array{ } map-as + malloc-underlying ; + +: marshall-char**-or-strings ( seq -- alien ) + [ (marshall-char**-or-strings) ] ptr-pass-through ; + +: marshall-bool ( ? -- n ) + >boolean [ 1 ] [ 0 ] if ; + +: (marshall-bool*) ( ?/seq -- alien ) + [ marshall-bool malloc-byte-array ] + [ >bool-array malloc-underlying ] + marshall-x* ; + +: marshall-bool* ( ?/seq -- alien ) + [ (marshall-bool*) ] ptr-pass-through ; + +: (marshall-bool**) ( seq -- alien ) + [ marshall-bool* ] map >void*-array malloc-underlying ; + +: marshall-bool** ( seq -- alien ) + [ (marshall-bool**) ] ptr-pass-through ; + +: unmarshall-bool ( n -- ? ) + 0 = not ; + +: unmarshall-bool* ( alien -- ? ) + *bool unmarshall-bool ; + +: unmarshall-bool*-free ( alien -- ? ) + [ *bool unmarshall-bool ] keep add-malloc free ; + +: primitive-marshaller ( type -- quot/f ) + { + { "bool" [ [ ] ] } + { "boolean" [ [ marshall-bool ] ] } + { "char" [ [ marshall-primitive ] ] } + { "uchar" [ [ marshall-primitive ] ] } + { "short" [ [ marshall-primitive ] ] } + { "ushort" [ [ marshall-primitive ] ] } + { "int" [ [ marshall-primitive ] ] } + { "uint" [ [ marshall-primitive ] ] } + { "long" [ [ marshall-primitive ] ] } + { "ulong" [ [ marshall-primitive ] ] } + { "long" [ [ marshall-primitive ] ] } + { "ulong" [ [ marshall-primitive ] ] } + { "float" [ [ marshall-primitive ] ] } + { "double" [ [ marshall-primitive ] ] } + { "bool*" [ [ marshall-bool* ] ] } + { "boolean*" [ [ marshall-bool* ] ] } + { "char*" [ [ marshall-char*-or-string ] ] } + { "uchar*" [ [ marshall-uchar* ] ] } + { "short*" [ [ marshall-short* ] ] } + { "ushort*" [ [ marshall-ushort* ] ] } + { "int*" [ [ marshall-int* ] ] } + { "uint*" [ [ marshall-uint* ] ] } + { "long*" [ [ marshall-long* ] ] } + { "ulong*" [ [ marshall-ulong* ] ] } + { "longlong*" [ [ marshall-longlong* ] ] } + { "ulonglong*" [ [ marshall-ulonglong* ] ] } + { "float*" [ [ marshall-float* ] ] } + { "double*" [ [ marshall-double* ] ] } + { "bool&" [ [ marshall-bool* ] ] } + { "boolean&" [ [ marshall-bool* ] ] } + { "char&" [ [ marshall-char* ] ] } + { "uchar&" [ [ marshall-uchar* ] ] } + { "short&" [ [ marshall-short* ] ] } + { "ushort&" [ [ marshall-ushort* ] ] } + { "int&" [ [ marshall-int* ] ] } + { "uint&" [ [ marshall-uint* ] ] } + { "long&" [ [ marshall-long* ] ] } + { "ulong&" [ [ marshall-ulong* ] ] } + { "longlong&" [ [ marshall-longlong* ] ] } + { "ulonglong&" [ [ marshall-ulonglong* ] ] } + { "float&" [ [ marshall-float* ] ] } + { "double&" [ [ marshall-double* ] ] } + { "void*" [ [ marshall-void* ] ] } + { "bool**" [ [ marshall-bool** ] ] } + { "boolean**" [ [ marshall-bool** ] ] } + { "char**" [ [ marshall-char**-or-strings ] ] } + { "uchar**" [ [ marshall-uchar** ] ] } + { "short**" [ [ marshall-short** ] ] } + { "ushort**" [ [ marshall-ushort** ] ] } + { "int**" [ [ marshall-int** ] ] } + { "uint**" [ [ marshall-uint** ] ] } + { "long**" [ [ marshall-long** ] ] } + { "ulong**" [ [ marshall-ulong** ] ] } + { "longlong**" [ [ marshall-longlong** ] ] } + { "ulonglong**" [ [ marshall-ulonglong** ] ] } + { "float**" [ [ marshall-float** ] ] } + { "double**" [ [ marshall-double** ] ] } + { "void**" [ [ marshall-void** ] ] } + [ drop f ] + } case ; + +: marshall-non-pointer ( alien-wrapper/byte-array -- byte-array ) + { + { [ dup byte-array? ] [ ] } + { [ dup alien-wrapper? ] + [ [ underlying>> ] [ class name>> heap-size ] bi + memory>byte-array ] } + } cond ; + + +: marshaller ( type -- quot ) + factorize-type dup primitive-marshaller [ nip ] [ + pointer? + [ [ marshall-pointer ] ] + [ [ marshall-non-pointer ] ] if + ] if* ; + + +: unmarshall-char*-to-string ( alien -- string ) + utf8 alien>string ; + +: unmarshall-char*-to-string-free ( alien -- string ) + [ unmarshall-char*-to-string ] keep add-malloc free ; + +: primitive-unmarshaller ( type -- quot/f ) + { + { "bool" [ [ ] ] } + { "boolean" [ [ unmarshall-bool ] ] } + { "char" [ [ ] ] } + { "uchar" [ [ ] ] } + { "short" [ [ ] ] } + { "ushort" [ [ ] ] } + { "int" [ [ ] ] } + { "uint" [ [ ] ] } + { "long" [ [ ] ] } + { "ulong" [ [ ] ] } + { "longlong" [ [ ] ] } + { "ulonglong" [ [ ] ] } + { "float" [ [ ] ] } + { "double" [ [ ] ] } + { "bool*" [ [ unmarshall-bool*-free ] ] } + { "boolean*" [ [ unmarshall-bool*-free ] ] } + { "char*" [ [ ] ] } + { "uchar*" [ [ unmarshall-uchar*-free ] ] } + { "short*" [ [ unmarshall-short*-free ] ] } + { "ushort*" [ [ unmarshall-ushort*-free ] ] } + { "int*" [ [ unmarshall-int*-free ] ] } + { "uint*" [ [ unmarshall-uint*-free ] ] } + { "long*" [ [ unmarshall-long*-free ] ] } + { "ulong*" [ [ unmarshall-ulong*-free ] ] } + { "longlong*" [ [ unmarshall-long*-free ] ] } + { "ulonglong*" [ [ unmarshall-ulong*-free ] ] } + { "float*" [ [ unmarshall-float*-free ] ] } + { "double*" [ [ unmarshall-double*-free ] ] } + { "bool&" [ [ unmarshall-bool*-free ] ] } + { "boolean&" [ [ unmarshall-bool*-free ] ] } + { "char&" [ [ ] ] } + { "uchar&" [ [ unmarshall-uchar*-free ] ] } + { "short&" [ [ unmarshall-short*-free ] ] } + { "ushort&" [ [ unmarshall-ushort*-free ] ] } + { "int&" [ [ unmarshall-int*-free ] ] } + { "uint&" [ [ unmarshall-uint*-free ] ] } + { "long&" [ [ unmarshall-long*-free ] ] } + { "ulong&" [ [ unmarshall-ulong*-free ] ] } + { "longlong&" [ [ unmarshall-longlong*-free ] ] } + { "ulonglong&" [ [ unmarshall-ulonglong*-free ] ] } + { "float&" [ [ unmarshall-float*-free ] ] } + { "double&" [ [ unmarshall-double*-free ] ] } + [ drop f ] + } case ; + +: struct-primitive-unmarshaller ( type -- quot/f ) + { + { "bool" [ [ unmarshall-bool ] ] } + { "boolean" [ [ unmarshall-bool ] ] } + { "char" [ [ ] ] } + { "uchar" [ [ ] ] } + { "short" [ [ ] ] } + { "ushort" [ [ ] ] } + { "int" [ [ ] ] } + { "uint" [ [ ] ] } + { "long" [ [ ] ] } + { "ulong" [ [ ] ] } + { "longlong" [ [ ] ] } + { "ulonglong" [ [ ] ] } + { "float" [ [ ] ] } + { "double" [ [ ] ] } + { "bool*" [ [ unmarshall-bool* ] ] } + { "boolean*" [ [ unmarshall-bool* ] ] } + { "char*" [ [ ] ] } + { "uchar*" [ [ unmarshall-uchar* ] ] } + { "short*" [ [ unmarshall-short* ] ] } + { "ushort*" [ [ unmarshall-ushort* ] ] } + { "int*" [ [ unmarshall-int* ] ] } + { "uint*" [ [ unmarshall-uint* ] ] } + { "long*" [ [ unmarshall-long* ] ] } + { "ulong*" [ [ unmarshall-ulong* ] ] } + { "longlong*" [ [ unmarshall-long* ] ] } + { "ulonglong*" [ [ unmarshall-ulong* ] ] } + { "float*" [ [ unmarshall-float* ] ] } + { "double*" [ [ unmarshall-double* ] ] } + { "bool&" [ [ unmarshall-bool* ] ] } + { "boolean&" [ [ unmarshall-bool* ] ] } + { "char&" [ [ unmarshall-char* ] ] } + { "uchar&" [ [ unmarshall-uchar* ] ] } + { "short&" [ [ unmarshall-short* ] ] } + { "ushort&" [ [ unmarshall-ushort* ] ] } + { "int&" [ [ unmarshall-int* ] ] } + { "uint&" [ [ unmarshall-uint* ] ] } + { "long&" [ [ unmarshall-long* ] ] } + { "ulong&" [ [ unmarshall-ulong* ] ] } + { "longlong&" [ [ unmarshall-longlong* ] ] } + { "ulonglong&" [ [ unmarshall-ulonglong* ] ] } + { "float&" [ [ unmarshall-float* ] ] } + { "double&" [ [ unmarshall-double* ] ] } + [ drop f ] + } case ; + + +: ?malloc-byte-array ( c-type -- alien ) + dup alien? [ malloc-byte-array ] unless ; + +:: x-unmarshaller ( type type-quot superclass def clean -- quot/f ) + type type-quot call current-vocab lookup [ + dup superclasses superclass swap member? + [ def call ] [ drop clean call f ] if + ] [ clean call f ] if* ; inline + +: struct-unmarshaller ( type -- quot/f ) + [ ] \ struct-wrapper + [ '[ ?malloc-byte-array _ new swap >>underlying ] ] + [ ] + x-unmarshaller ; + +: class-unmarshaller ( type -- quot/f ) + [ type-sans-pointer "#" append ] \ class-wrapper + [ '[ _ new swap >>underlying ] ] + [ ] + x-unmarshaller ; + +: non-primitive-unmarshaller ( type -- quot/f ) + { + { [ dup pointer? ] [ class-unmarshaller ] } + [ struct-unmarshaller ] + } cond ; + +: unmarshaller ( type -- quot ) + factorize-type { + [ primitive-unmarshaller ] + [ non-primitive-unmarshaller ] + [ drop [ ] ] + } 1|| ; + +: struct-field-unmarshaller ( type -- quot ) + factorize-type { + [ struct-primitive-unmarshaller ] + [ non-primitive-unmarshaller ] + [ drop [ ] ] + } 1|| ; + +: out-arg-unmarshaller ( type -- quot ) + dup pointer-to-non-const-primitive? + [ factorize-type primitive-unmarshaller ] + [ drop [ drop ] ] if ; diff --git a/alien/marshall/private/authors.txt b/alien/marshall/private/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/marshall/private/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/marshall/private/private.factor b/alien/marshall/private/private.factor new file mode 100644 index 0000000..d138282 --- /dev/null +++ b/alien/marshall/private/private.factor @@ -0,0 +1,61 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien alien.c-types alien.inline arrays +combinators fry functors kernel lexer libc macros math +sequences specialized-arrays libc.private +combinators.short-circuit alien.data ; +SPECIALIZED-ARRAY: void* +IN: alien.marshall.private + +: bool>arg ( ? -- 1/0/obj ) + { + { t [ 1 ] } + { f [ 0 ] } + [ ] + } case ; + +MACRO: marshall-x* ( num-quot seq-quot -- alien ) + '[ bool>arg dup number? _ _ if ] ; + +: ptr-pass-through ( obj quot -- alien ) + over { [ c-ptr? ] [ ] } 1&& [ drop ] [ call ] if ; inline + +: malloc-underlying ( obj -- alien ) + underlying>> malloc-byte-array ; + +FUNCTOR: define-primitive-marshallers ( TYPE -- ) + IS <${TYPE}> +*TYPE IS *${TYPE} +>TYPE-array IS >${TYPE}-array +marshall-TYPE DEFINES marshall-${TYPE} +(marshall-TYPE*) DEFINES (marshall-${TYPE}*) +(marshall-TYPE**) DEFINES (marshall-${TYPE}**) +marshall-TYPE* DEFINES marshall-${TYPE}* +marshall-TYPE** DEFINES marshall-${TYPE}** +marshall-TYPE*-free DEFINES marshall-${TYPE}*-free +marshall-TYPE**-free DEFINES marshall-${TYPE}**-free +unmarshall-TYPE* DEFINES unmarshall-${TYPE}* +unmarshall-TYPE*-free DEFINES unmarshall-${TYPE}*-free +WHERE + malloc-byte-array ] + [ >TYPE-array malloc-underlying ] + marshall-x* ; +PRIVATE> +: marshall-TYPE* ( n/seq -- alien ) + [ (marshall-TYPE*) ] ptr-pass-through ; + +: marshall-TYPE** ( seq -- alien ) + [ (marshall-TYPE**) ] ptr-pass-through ; +: unmarshall-TYPE* ( alien -- n ) + *TYPE ; inline +: unmarshall-TYPE*-free ( alien -- n ) + [ unmarshall-TYPE* ] keep add-malloc free ; +;FUNCTOR + +SYNTAX: PRIMITIVE-MARSHALLERS: +";" parse-tokens [ define-primitive-marshallers ] each ; diff --git a/alien/marshall/structs/authors.txt b/alien/marshall/structs/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/marshall/structs/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/marshall/structs/structs-docs.factor b/alien/marshall/structs/structs-docs.factor new file mode 100644 index 0000000..0c56458 --- /dev/null +++ b/alien/marshall/structs/structs-docs.factor @@ -0,0 +1,19 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: classes help.markup help.syntax kernel quotations words +alien.marshall.structs strings alien.structs alien.marshall ; +IN: alien.marshall.structs + +HELP: define-marshalled-struct +{ $values + { "name" string } { "vocab" "a vocabulary specifier" } { "fields" "an alist" } +} +{ $description "Calls " { $link define-struct } " and " { $link define-struct-tuple } "." } ; + +HELP: define-struct-tuple +{ $values + { "name" string } +} +{ $description "Defines a subclass of " { $link struct-wrapper } ", a constructor, " + "and accessor words." +} ; diff --git a/alien/marshall/structs/structs.factor b/alien/marshall/structs/structs.factor new file mode 100644 index 0000000..07ebb6a --- /dev/null +++ b/alien/marshall/structs/structs.factor @@ -0,0 +1,50 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.c-types alien.marshall arrays assocs +classes.tuple combinators destructors generalizations generic +kernel libc locals parser quotations sequences slots words +alien.structs lexer vocabs.parser fry effects alien.data ; +IN: alien.marshall.structs + +>" append \ underlying>> ] 2dip + struct-field-unmarshaller \ call 4array >quotation + define-struct-accessor ; + +: define-struct-setter ( class name word type -- ) + [ "<<" append ] 2dip + marshaller [ underlying>> ] \ bi* roll 4array >quotation + define-struct-accessor ; + +: define-struct-accessors ( class name type reader writer -- ) + [ dup define-protocol-slot ] 3dip + [ drop swap define-struct-getter ] + [ nip swap define-struct-setter ] 5 nbi ; + +: define-struct-constructor ( class -- ) + { + [ name>> "<" prepend ">" append create-word-in ] + [ '[ _ new ] ] + [ name>> '[ _ malloc-struct >>underlying ] append ] + [ name>> 1array ] + } cleave { } swap define-declared ; +PRIVATE> + +:: define-struct-tuple ( name -- ) + name create-word-in :> class + class struct-wrapper { } define-tuple-class + class define-struct-constructor + name c-type fields>> [ + class swap + { + [ name>> H{ { CHAR: space CHAR: - } } substitute ] + [ type>> ] [ reader>> ] [ writer>> ] + } cleave define-struct-accessors + ] each ; + +: define-marshalled-struct ( name vocab fields -- ) + [ define-struct ] [ 2drop define-struct-tuple ] 3bi ; diff --git a/alien/marshall/syntax/authors.txt b/alien/marshall/syntax/authors.txt new file mode 100644 index 0000000..845910d --- /dev/null +++ b/alien/marshall/syntax/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/alien/marshall/syntax/syntax-docs.factor b/alien/marshall/syntax/syntax-docs.factor new file mode 100644 index 0000000..4d296cc --- /dev/null +++ b/alien/marshall/syntax/syntax-docs.factor @@ -0,0 +1,84 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: help.markup help.syntax kernel quotations words +alien.inline alien.syntax effects alien.marshall +alien.marshall.structs strings sequences alien.inline.syntax ; +IN: alien.marshall.syntax + +HELP: CM-FUNCTION: +{ $syntax "CM-FUNCTION: return name args\n body\n;" } +{ $description "Like " { $link POSTPONE: C-FUNCTION: } " but with marshalling " + "of arguments and return values." +} +{ $examples + { $example + "USING: alien.inline.syntax alien.marshall.syntax prettyprint ;" + "IN: example" + "" + "C-LIBRARY: exlib" + "" + "C-INCLUDE: " + "C-INCLUDE: " + "CM-FUNCTION: char* sum_diff ( const-int a, const-int b, int* x, int* y )" + " *x = a + b;" + " *y = a - b;" + " char* s = (char*) malloc(sizeof(char) * 64);" + " sprintf(s, \"sum %i, diff %i\", *x, *y);" + " return s;" + ";" + "" + ";C-LIBRARY" + "" + "8 5 0 0 sum_diff . . ." + "3\n13\n\"sum 13, diff 3\"" + } +} +{ $see-also define-c-marshalled POSTPONE: C-FUNCTION: POSTPONE: M-FUNCTION: } ; + +HELP: CM-STRUCTURE: +{ $syntax "CM-STRUCTURE: name fields ... ;" } +{ $description "Like " { $link POSTPONE: C-STRUCTURE: } " but with marshalling of fields. " + "Defines a subclass of " { $link struct-wrapper } " a constructor, and slot-like accessor words." +} +{ $see-also POSTPONE: C-STRUCTURE: POSTPONE: M-STRUCTURE: } ; + +HELP: M-FUNCTION: +{ $syntax "M-FUNCTION: return name args ;" } +{ $description "Like " { $link POSTPONE: FUNCTION: } " but with marshalling " + "of arguments and return values." +} +{ $see-also marshalled-function POSTPONE: C-FUNCTION: POSTPONE: CM-FUNCTION: } ; + +HELP: M-STRUCTURE: +{ $syntax "M-STRUCTURE: name fields ... ;" } +{ $description "Like " { $link POSTPONE: C-STRUCT: } " but with marshalling of fields. " + "Defines a subclass of " { $link struct-wrapper } " a constructor, and slot-like accessor words." +} +{ $see-also define-marshalled-struct POSTPONE: C-STRUCTURE: POSTPONE: CM-STRUCTURE: } ; + +HELP: define-c-marshalled +{ $values + { "name" string } { "types" sequence } { "effect" effect } { "body" string } +} +{ $description "Defines a C function and a factor word which calls it with marshalling of " + "args and return values." +} +{ $see-also define-c-marshalled' } ; + +HELP: define-c-marshalled' +{ $values + { "name" string } { "effect" effect } { "body" string } +} +{ $description "Like " { $link define-c-marshalled } ". " + "The effect elements must be C type strings." +} ; + +HELP: marshalled-function +{ $values + { "name" string } { "types" sequence } { "effect" effect } + { "word" word } { "quot" quotation } { "effect" effect } +} +{ $description "Defines a word which calls the named C function. Arguments, " + "return value, and output parameters are marshalled and unmarshalled." +} ; + diff --git a/alien/marshall/syntax/syntax-tests.factor b/alien/marshall/syntax/syntax-tests.factor new file mode 100644 index 0000000..4376851 --- /dev/null +++ b/alien/marshall/syntax/syntax-tests.factor @@ -0,0 +1,75 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.inline.syntax alien.marshall.syntax destructors +tools.test accessors kernel ; +IN: alien.marshall.syntax.tests + +DELETE-C-LIBRARY: test +C-LIBRARY: test + +C-INCLUDE: +C-INCLUDE: +C-INCLUDE: + +CM-FUNCTION: void outarg1 ( int* a ) + *a += 2; +; + +CM-FUNCTION: unsigned-long* outarg2 ( unsigned-long a, unsigned-long* b ) + unsigned long* x = malloc(sizeof(unsigned long*)); + *b = 10 + *b; + *x = a + *b; + return x; +; + +CM-STRUCTURE: wedge + { "double" "degrees" } ; + +CM-STRUCTURE: sundial + { "double" "radius" } + { "wedge" "wedge" } ; + +CM-FUNCTION: double hours ( sundial* d ) + return d->wedge.degrees / 30; +; + +CM-FUNCTION: void change_time ( double hours, sundial* d ) + d->wedge.degrees = hours * 30; +; + +CM-FUNCTION: bool c_not ( bool p ) + return !p; +; + +CM-FUNCTION: char* upcase ( const-char* s ) + int len = strlen(s); + char* t = malloc(sizeof(char) * len); + int i; + for (i = 0; i < len; i++) + t[i] = toupper(s[i]); + t[i] = '\0'; + return t; +; + +;C-LIBRARY + +{ 1 1 } [ outarg1 ] must-infer-as +[ 3 ] [ 1 outarg1 ] unit-test +[ 3 ] [ t outarg1 ] unit-test +[ 2 ] [ f outarg1 ] unit-test + +{ 2 2 } [ outarg2 ] must-infer-as +[ 18 15 ] [ 3 5 outarg2 ] unit-test + +{ 1 1 } [ hours ] must-infer-as +[ 5.0 ] [ 150 >>degrees >>wedge hours ] unit-test + +{ 2 0 } [ change_time ] must-infer-as +[ 150.0 ] [ 5 11 >>degrees >>wedge [ change_time ] keep wedge>> degrees>> ] unit-test + +{ 1 1 } [ c_not ] must-infer-as +[ f ] [ "x" c_not ] unit-test +[ f ] [ 0 c_not ] unit-test + +{ 1 1 } [ upcase ] must-infer-as +[ "ABC" ] [ "abc" upcase ] unit-test diff --git a/alien/marshall/syntax/syntax.factor b/alien/marshall/syntax/syntax.factor new file mode 100644 index 0000000..3343436 --- /dev/null +++ b/alien/marshall/syntax/syntax.factor @@ -0,0 +1,50 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.inline alien.inline.types alien.marshall +combinators effects generalizations kernel locals make namespaces +quotations sequences words alien.marshall.structs lexer parser +vocabs.parser multiline ; +IN: alien.marshall.syntax + +:: marshalled-function ( name types effect -- word quot effect ) + name types effect factor-function + [ in>> ] + [ out>> types [ pointer-to-non-const-primitive? ] filter append ] + bi + [ + [ + types [ marshaller ] map , \ spread , , + types length , \ nkeep , + types [ out-arg-unmarshaller ] map + effect out>> dup empty? + [ drop ] [ first unmarshaller prefix ] if + , \ spread , + ] [ ] make + ] dip ; + +: define-c-marshalled ( name types effect body -- ) + [ + [ marshalled-function define-declared ] + [ prototype-string ] 3bi + ] dip append-function-body c-strings get push ; + +: define-c-marshalled' ( name effect body -- ) + [ + [ in>> ] keep + [ marshalled-function define-declared ] + [ out>> prototype-string' ] 3bi + ] dip append-function-body c-strings get push ; + +SYNTAX: CM-FUNCTION: + function-types-effect parse-here define-c-marshalled ; + +SYNTAX: M-FUNCTION: + function-types-effect marshalled-function define-declared ; + +SYNTAX: M-STRUCTURE: + scan current-vocab parse-definition + define-marshalled-struct ; + +SYNTAX: CM-STRUCTURE: + scan current-vocab parse-definition + [ define-marshalled-struct ] [ nip define-c-struct ] 3bi ; diff --git a/animations/animations-docs.factor b/animations/animations-docs.factor new file mode 100644 index 0000000..1acdfd3 --- /dev/null +++ b/animations/animations-docs.factor @@ -0,0 +1,67 @@ +USING: help.markup help.syntax ; +IN: animations + +HELP: animate + +{ $values + { "quot" "a quot which uses " { $link progress } } + { "duration" "a duration of time" } +} +{ $description + { $link animate } " calls " { $link reset-progress } + " , then continously calls the given quot until the" + " duration of time has elapsed. The quot should use " + { $link progress } " at least once." +} +{ $examples + { $unchecked-example + "USING: animations calendar threads prettyprint ;" + "[ 1 sleep progress unparse write \" ms elapsed\" print ] " + "1/20 seconds animate ;" + "46 ms elapsed\n17 ms elapsed" + } + { $notes "The amount of time elapsed between these iterations will vary." } +} ; + +HELP: reset-progress +{ $description + "Initiates the timer. Call this before using " + "a loop which makes use of " { $link progress } "." +} ; + +HELP: progress +{ $values { "time" "an integer" } } +{ $description + "Gives the time elapsed since the last time" + " this word was called, in milliseconds." +} +{ $examples + { $unchecked-example + "USING: animations threads prettyprint ;" + "reset-progress 3 " + "[ 1 sleep progress unparse write \"ms elapsed\" print ] " + "times ;" + "31 ms elapsed\n18 ms elapsed\n16 ms elapsed" + } + { $notes "The amount of time elapsed between these iterations will vary." } +} ; + +ARTICLE: "animations" "Animations" +"Provides a lightweight framework for properly simulating continuous" +" functions of real time. This framework helps one create animations " +"that use rates which do not change across platforms. The speed of the " +"computer should correlate with the smoothness of the animation, not " +"the speed of the animation!" +{ $subsections + animate + reset-progress + progress +} +! A little talk about when to use progress and when to use animate + { $link progress } " specifically provides the length of time since " + { $link reset-progress } " was called, and also calls " + { $link reset-progress } " as its last action. This can be directly " + "used when one's quote runs for a specific number of iterations, instead " + "of a length of time. If the animation is like most, and is expected to " + "run for a specific length of time, " { $link animate } " should be used." ; +ABOUT: "animations" diff --git a/animations/animations.factor b/animations/animations.factor new file mode 100644 index 0000000..8f416dc --- /dev/null +++ b/animations/animations.factor @@ -0,0 +1,17 @@ +! Small library for cross-platform continuous functions of real time + +USING: kernel shuffle system locals +prettyprint math io namespaces threads calendar ; +IN: animations + +SYMBOL: last-loop +SYMBOL: sleep-period + +: reset-progress ( -- ) millis last-loop set ; +! : my-progress ( -- progress ) millis +: progress ( -- time ) millis last-loop get - reset-progress ; +: progress-peek ( -- progress ) millis last-loop get - ; +: set-end ( duration -- end-time ) duration>milliseconds millis + ; +: loop ( quot end -- ) dup millis > [ [ dup call ] dip loop ] [ 2drop ] if ; inline +: animate ( quot duration -- ) reset-progress set-end loop ; inline +: sample ( revs quot -- avg ) reset-progress dupd times progress swap / ; inline diff --git a/animations/authors.txt b/animations/authors.txt new file mode 100644 index 0000000..0f10bf5 --- /dev/null +++ b/animations/authors.txt @@ -0,0 +1 @@ +Reginald Ford diff --git a/arm/4/4.factor b/arm/4/4.factor new file mode 100644 index 0000000..0d317fd --- /dev/null +++ b/arm/4/4.factor @@ -0,0 +1,45 @@ +! Copyright (C) 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien arrays cpu.architecture cpu.arm.assembler +cpu.arm.architecture cpu.arm5.assembler kernel kernel.private +math math.private namespaces sequences words quotations +byte-arrays hashtables.private hashtables generator +generator.registers generator.fixup sequences.private +strings.private ; +IN: cpu.arm4 + +: (%char-slot) + "out" operand string-offset MOV + "out" operand dup "n" operand 2 ADD ; + +\ char-slot [ + (%char-slot) + "out" operand "obj" operand "out" operand <+> LDRH + "out" operand dup %tag-fixnum +] H{ + { +input+ { { f "n" } { f "obj" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +\ set-char-slot [ + "val" operand dup %untag-fixnum + (%char-slot) + "val" operand "obj" operand "out" operand <+> STRH +] H{ + { +input+ { { f "val" } { f "n" } { f "obj" } } } + { +scratch+ { { f "out" } } } + { +clobber+ { "val" } } +} define-intrinsic + +\ alien-signed-1 [ LDRSB ] +\ set-alien-signed-1 [ STRB ] +define-alien-integer-intrinsics + +\ alien-unsigned-2 [ LDRH ] +\ set-alien-unsigned-2 [ STRH ] +define-alien-integer-intrinsics + +\ alien-signed-2 [ LDRSH ] +\ set-alien-signed-2 [ STRH ] +define-alien-integer-intrinsics diff --git a/arm/4/authors.txt b/arm/4/authors.txt new file mode 100644 index 0000000..1901f27 --- /dev/null +++ b/arm/4/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/arm/4/summary.txt b/arm/4/summary.txt new file mode 100644 index 0000000..7be5231 --- /dev/null +++ b/arm/4/summary.txt @@ -0,0 +1 @@ +Additional compiler intrinsics for ARM4 diff --git a/arm/allot/allot.factor b/arm/allot/allot.factor new file mode 100644 index 0000000..6949d3b --- /dev/null +++ b/arm/allot/allot.factor @@ -0,0 +1,79 @@ +! Copyright (C) 2006, 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel cpu.architecture cpu.arm.assembler +cpu.arm.architecture namespaces math sequences +generator generator.registers generator.fixup system layouts +alien ; +IN: cpu.arm.allot + +: load-zone-ptr ( reg -- ) "nursery" f rot %alien-global ; + +: %allot ( header size -- ) + ! Store a pointer to 'size' bytes allocated from the + ! nursery in R11 + 8 align ! align the size + R12 load-zone-ptr ! nusery -> r12 + R11 R12 cell <+> LDR ! nursery.here -> r11 + R11 R11 pick ADD ! increment r11 + R11 R12 cell <+> STR ! r11 -> nursery.here + R11 R11 rot SUB ! old value + R12 swap type-number tag-fixnum MOV ! compute header + R12 R11 0 <+> STR ! store header + ; + +: %store-tagged ( reg tag -- ) + >r dup fresh-object v>operand R11 r> tag-number ORR ; + +: %allot-bignum ( #digits -- ) + ! 1 cell header, 1 cell length, 1 cell sign, + digits + ! length is the # of digits + sign + bignum over 3 + cells %allot + R12 swap 1+ v>operand MOV ! compute the length + R12 R11 cell <+> STR ! store the length + ; + +: %allot-bignum-signed-1 ( dst src -- ) + ! on entry, reg is a 30-bit quantity sign-extended to + ! 32-bits. + ! exits with tagged ptr to bignum in reg. + [ + "end" define-label + ! is it zero? + dup v>operand 0 CMP + 0 >bignum pick EQ load-literal + "end" get EQ B + ! ! it is non-zero + 1 %allot-bignum + ! is the fixnum negative? + dup v>operand 0 CMP + ! negative sign + R12 1 LT MOV + ! negate fixnum + dup v>operand dup 0 LT RSB + ! positive sign + R12 0 GE MOV + ! store sign + R12 R11 2 cells <+> STR + ! store the number + v>operand R11 3 cells <+> STR + ! tag the bignum, store it in reg + bignum %store-tagged + "end" resolve-label + ] with-scope ; + +M: arm-backend %box-alien ( dst src -- ) + "end" define-label + dup v>operand 0 CMP + over v>operand f v>operand EQ MOV + "end" get EQ B + alien 4 cells %allot + ! Store offset + v>operand R11 3 cells <+> STR + R12 f v>operand MOV + ! Store expired slot + R12 R11 1 cells <+> STR + ! Store underlying-alien slot + R12 R11 2 cells <+> STR + ! Store tagged ptr in reg + object %store-tagged + "end" resolve-label ; diff --git a/arm/allot/authors.txt b/arm/allot/authors.txt new file mode 100644 index 0000000..1901f27 --- /dev/null +++ b/arm/allot/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/arm/architecture/architecture.factor b/arm/architecture/architecture.factor new file mode 100644 index 0000000..f4ad13d --- /dev/null +++ b/arm/architecture/architecture.factor @@ -0,0 +1,370 @@ +! Copyright (C) 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types arrays cpu.arm.assembler compiler +kernel kernel.private math namespaces words words.private +generator.registers generator.fixup generator cpu.architecture +system layouts ; +IN: cpu.arm.architecture + +TUPLE: arm-backend ; + +! ARM register assignments: +! R0-R4, R7-R10 integer vregs +! R11, R12 temporary +! R5 data stack +! R6 retain stack +! R7 primitives + +: ds-reg R5 ; inline +: rs-reg R6 ; inline + +M: temp-reg v>operand drop R12 ; + +M: int-regs return-reg drop R0 ; +M: int-regs param-regs drop { R0 R1 R2 R3 } ; +M: int-regs vregs drop { R0 R1 R2 R3 R4 R7 R8 R9 R10 } ; + +! No FPU support yet +M: float-regs param-regs drop { } ; +M: float-regs vregs drop { } ; + +: <+/-> dup 0 < [ neg <-> ] [ <+> ] if ; + +GENERIC: loc>operand ( loc -- reg addressing ) +M: ds-loc loc>operand ds-loc-n cells neg ds-reg swap <+/-> ; +M: rs-loc loc>operand rs-loc-n cells neg rs-reg swap <+/-> ; + +: load-cell ( reg -- ) + [ + "end" define-label + ! Load target address + PC 0 <+> LDR + ! Skip an instruction + "end" get B + ! The target address + 0 , + ! Continue here + "end" resolve-label + ] with-scope ; + +: call-cell ( -- ) + ! Compute return address; we skip 3 instructions + LR PC 8 ADD + ! Load target address + R12 PC 0 <+> LDR + ! Jump to target address + R12 BX + ! The target address + 0 , ; + +M: arm-backend load-indirect ( obj reg -- ) + tuck load-cell rc-absolute-cell rel-literal + dup 0 <+> LDR ; + +M: immediate load-literal + over v>operand small-enough? [ + [ v>operand ] bi@ swap MOV + ] [ + v>operand load-indirect + ] if ; + +: lr-save ( n -- i ) cell - ; +: next-save ( n -- i ) 2 cells - ; +: xt-save ( n -- i ) 3 cells - ; +: factor-area-size 5 cells ; + +M: arm-backend stack-frame ( n -- i ) + factor-area-size + 8 align ; + +M: arm-backend %save-word-xt ( -- ) + R12 PC 9 cells SUB ; + +M: arm-backend %save-dispatch-xt ( -- ) + R12 PC 2 cells SUB ; + +M: arm-backend %prologue ( n -- ) + SP SP pick SUB + R11 over MOV + R11 SP pick next-save <+> STR + R12 SP pick xt-save <+> STR + LR SP rot lr-save <+> STR ; + +M: arm-backend %epilogue ( n -- ) + LR SP pick lr-save <+> LDR + SP SP rot ADD ; + +: compile-dlsym ( symbol dll reg -- ) + load-cell rc-absolute rel-dlsym ; + +: %alien-global ( symbol dll reg -- ) + [ compile-dlsym ] keep dup 0 <+> LDR ; + +M: arm-backend %profiler-prologue ( -- ) + ! We can clobber R0 here since it is undefined at the start + ! of a word. + R12 load-indirect + R0 R12 profile-count-offset <+> LDR + R0 R0 1 v>operand ADD + R0 R12 profile-count-offset <+> STR ; + +M: arm-backend %call-label ( label -- ) BL ; + +M: arm-backend %jump-label ( label -- ) B ; + +: %prepare-primitive ( -- ) + ! Save stack pointer to stack_chain->callstack_top, load XT + R1 SP 4 SUB ; + +M: arm-backend %call-primitive ( word -- ) + %prepare-primitive + call-cell rc-absolute-cell rel-word ; + +M: arm-backend %jump-primitive ( word -- ) + %prepare-primitive + ! Load target address + R12 PC 0 <+> LDR + ! Jump to target address + R12 BX + ! The target address + 0 , rc-absolute-cell rel-word ; + +M: arm-backend %jump-t ( label -- ) + "flag" operand f v>operand CMP NE B ; + +: (%dispatch) ( word-table# -- ) + ! Load jump table target address into reg. + "scratch" operand PC "n" operand 1 ADD + "scratch" operand dup 0 <+> LDR + rc-indirect-arm rel-dispatch + "scratch" operand dup compiled-header-size ADD ; + +M: arm-backend %call-dispatch ( word-table# -- ) + [ + (%dispatch) + "scratch" operand BLX + ] H{ + { +input+ { { f "n" } } } + { +scratch+ { { f "scratch" } } } + } with-template ; + +M: arm-backend %jump-dispatch ( word-table# -- ) + [ + %epilogue-later + (%dispatch) + "scratch" operand BX + ] H{ + { +input+ { { f "n" } } } + { +scratch+ { { f "scratch" } } } + } with-template ; + +M: arm-backend %return ( -- ) %epilogue-later PC LR MOV ; + +M: arm-backend %unwind drop %return ; + +M: arm-backend %peek >r v>operand r> loc>operand LDR ; + +M: arm-backend %replace >r v>operand r> loc>operand STR ; + +: (%inc) ( n reg -- ) + dup rot cells dup 0 < [ neg SUB ] [ ADD ] if ; + +M: arm-backend %inc-d ( n -- ) ds-reg (%inc) ; + +M: arm-backend %inc-r ( n -- ) rs-reg (%inc) ; + +: stack@ SP swap <+> ; + +M: int-regs %save-param-reg drop swap stack@ STR ; + +M: int-regs %load-param-reg drop swap stack@ LDR ; + +M: stack-params %save-param-reg + drop + R12 swap stack-frame* + stack@ LDR + R12 swap stack@ STR ; + +M: stack-params %load-param-reg + drop + R12 rot stack@ LDR + R12 swap stack@ STR ; + +M: arm-backend %prepare-unbox ( -- ) + ! First parameter is top of stack + R0 R5 4 <-!> LDR ; + +M: arm-backend %unbox ( n reg-class func -- ) + ! Value must be in R0. + ! Call the unboxer + f %alien-invoke + ! Store the return value on the C stack + over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ; + +M: arm-backend %unbox-long-long ( n func -- ) + ! Value must be in R0:R1. + ! Call the unboxer + f %alien-invoke + ! Store the return value on the C stack + [ + R0 over stack@ STR + R1 swap cell + stack@ STR + ] when* ; + +M: arm-backend %unbox-small-struct ( size -- ) + ! Alien must be in R0. + drop + "alien_offset" f %alien-invoke + ! Load first cell + R0 R0 0 <+> LDR ; + +M: arm-backend %unbox-large-struct ( n size -- ) + ! Alien must be in R0. + ! Compute destination address + R1 SP roll ADD + R2 swap MOV + ! Copy the struct to the stack + "to_value_struct" f %alien-invoke ; + +M: arm-backend %box ( n reg-class func -- ) + ! If the source is a stack location, load it into freg #0. + ! If the source is f, then we assume the value is already in + ! freg #0. + >r + over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if + r> f %alien-invoke ; + +M: arm-backend %box-long-long ( n func -- ) + >r [ + R0 over stack@ LDR + R1 swap cell + stack@ LDR + ] when* r> f %alien-invoke ; + +M: arm-backend %box-small-struct ( size -- ) + ! Box a 4-byte struct returned in R0. + R2 swap MOV + "box_small_struct" f %alien-invoke ; + +: temp@ stack-frame* factor-area-size - swap - ; + +: struct-return@ ( size n -- n ) + [ + stack-frame* + + ] [ + stack-frame* factor-area-size - swap - + ] ?if ; + +M: arm-backend %prepare-box-struct ( size -- ) + ! Compute target address for value struct return + R0 SP rot f struct-return@ ADD + ! Store it as the first parameter + R0 0 stack@ STR ; + +M: arm-backend %box-large-struct ( n size -- ) + ! Compute destination address + [ swap struct-return@ ] keep + R0 SP roll ADD + R1 swap MOV + ! Copy the struct from the C stack + "box_value_struct" f %alien-invoke ; + +M: arm-backend struct-small-enough? ( size -- ? ) + 4 <= ; + +M: arm-backend %prepare-alien-invoke + ! Save Factor stack pointers in case the C code calls a + ! callback which does a GC, which must reliably trace + ! all roots. + "stack_chain" f R12 %alien-global + SP R12 0 <+> STR + ds-reg R12 8 <+> STR + rs-reg R12 12 <+> STR ; + +M: arm-backend %alien-invoke ( symbol dll -- ) + call-cell rc-absolute-cell rel-dlsym ; + +M: arm-backend %prepare-alien-indirect ( -- ) + "unbox_alien" f %alien-invoke + R0 SP cell temp@ <+> STR ; + +M: arm-backend %alien-indirect ( -- ) + R12 SP cell temp@ <+> LDR + R12 BLX ; + +M: arm-backend %alien-callback ( quot -- ) + R0 load-indirect + "c_to_factor" f %alien-invoke ; + +M: arm-backend %callback-value ( ctype -- ) + ! Save top of data stack + %prepare-unbox + R0 SP cell temp@ <+> STR + ! Restore data/call/retain stacks + "unnest_stacks" f %alien-invoke + ! Place former top of data stack in R0 + R0 SP cell temp@ <+> LDR + ! Unbox R0 + unbox-return ; + +M: arm-backend %cleanup ( alien-node -- ) drop ; + +: %untag ( dest src -- ) 0b111 BIC ; + +: %untag-fixnum ( dest src -- ) tag-bits get MOV ; + +: %tag-fixnum ( dest src -- ) tag-bits get MOV ; + +M: arm-backend value-structs? t ; + +M: arm-backend small-enough? ( n -- ? ) 0 255 between? ; + +M: long-long-type c-type-stack-align? drop t ; + +M: arm-backend fp-shadows-int? ( -- ? ) f ; + +! Alien intrinsics +M: arm-backend %unbox-byte-array ( dst src -- ) + [ v>operand ] bi@ byte-array-offset ADD ; + +M: arm-backend %unbox-alien ( dst src -- ) + [ v>operand ] bi@ alien-offset <+> LDR ; + +M: arm-backend %unbox-f ( dst src -- ) + drop v>operand 0 MOV ; + +M: arm-backend %unbox-any-c-ptr ( dst src -- ) + ! We need three registers here. R11 and R12 are reserved + ! temporary registers. The third one is R14, which we have + ! to save/restore. + "end" define-label + "start" define-label + ! Save R14. + R14 SP 4 <-> STR + ! Address is computed in R11 + R11 0 MOV + ! Load object into R12 + R12 swap v>operand MOV + ! We come back here with displaced aliens + "start" resolve-label + ! Is the object f? + R12 f v>operand CMP + ! If so, done + "end" get EQ B + ! Is the object an alien? + R14 R12 header-offset <+/-> LDR + R14 alien type-number tag-fixnum CMP + ! Add byte array address to address being computed + R11 R11 R12 NE ADD + ! Add an offset to start of byte array's data area + R11 R11 byte-array-offset NE ADD + "end" get NE B + ! If alien, load the offset + R14 R12 alien-offset <+/-> LDR + ! Add it to address being computed + R11 R11 R14 ADD + ! Now recurse on the underlying alien + R12 R12 underlying-alien-offset <+/-> LDR + "start" get B + "end" resolve-label + ! Done, store address in destination register + v>operand R11 MOV + ! Restore R14. + R14 SP 4 <-> LDR ; diff --git a/arm/architecture/authors.txt b/arm/architecture/authors.txt new file mode 100644 index 0000000..1901f27 --- /dev/null +++ b/arm/architecture/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/arm/arm.factor b/arm/arm.factor new file mode 100644 index 0000000..641beee --- /dev/null +++ b/arm/arm.factor @@ -0,0 +1,56 @@ +! Copyright (C) 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien alien.c-types kernel math namespaces +cpu.architecture cpu.arm.architecture cpu.arm.assembler +cpu.arm.intrinsics generator generator.registers continuations +compiler io vocabs sequences system ; + +! EABI passes floats in integer registers. +[ alien-float ] +[ >r >r >float r> r> set-alien-float ] +4 +"box_float" +"to_float" +"float" define-primitive-type + +[ >float ] "float" c-type set-c-type-prep + +[ alien-double ] +[ >r >r >float r> r> set-alien-double ] +8 +"box_double" +"to_double"

+"double" define-primitive-type + +[ >float ] "double" c-type set-c-type-prep + +T{ arm-backend } compiler-backend set-global + +! We don't auto-detect since that would require us to support +! illegal instruction traps. This works on Linux but not on +! Windows CE. + +"arm-variant" get [ + "ARM variant: " write "arm-variant" get print +] [ + "==========" print + "You should specify the -arm-variant= switch." print + " can be one of arm3, arm4, arm4t, or arm5." print + "Assuming arm3." print + "==========" print + "arm3" "arm-variant" set-global +] if + +"arm-variant" get { "arm4" "arm4t" "arm5" } member? [ + "cpu.arm.4" require +] when + +"arm-variant" get { "arm4t" "arm5" } member? [ + t have-BX? set-global +] when + +"arm-variant" get "arm5" = [ + t have-BLX? set-global +] when + +7 cells profiler-prologues set-global diff --git a/arm/authors.txt b/arm/authors.txt new file mode 100644 index 0000000..1901f27 --- /dev/null +++ b/arm/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/arm/bootstrap.factor b/arm/bootstrap.factor new file mode 100644 index 0000000..793a488 --- /dev/null +++ b/arm/bootstrap.factor @@ -0,0 +1,119 @@ +! Copyright (C) 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: bootstrap.image.private kernel namespaces system +cpu.arm.assembler math layouts words compiler.units ; +IN: bootstrap.arm + +! We generate ARM3 code +f have-BX? set + +4 \ cell set +big-endian off + +4 jit-code-format set + +: ds-reg R5 ; + +: word-reg R0 ; +: quot-reg R0 ; +: scan-reg R2 ; +: temp-reg R3 ; +: xt-reg R12 ; + +: stack-frame 16 bootstrap-cells ; + +: next-save stack-frame 2 bootstrap-cells - ; +: xt-save stack-frame 3 bootstrap-cells - ; +: array-save stack-frame 4 bootstrap-cells - ; +: scan-save stack-frame 5 bootstrap-cells - ; + +[ + temp-reg quot-reg quot-array@ <+> LDR ! load array + scan-reg temp-reg scan@ ADD ! initialize scan pointer +] { } make jit-setup set + +[ + LR SP 4 <-> STR ! save return address + SP SP stack-frame SUB + xt-reg SP xt-save <+> STR ! save XT + xt-reg stack-frame MOV + xt-reg SP next-save <+> STR ! save frame size + temp-reg SP array-save <+> STR ! save array +] { } make jit-prolog set + +[ + temp-reg scan-reg 4 LDR ! load literal and advance + temp-reg ds-reg 4 STR ! push literal +] { } make jit-push-literal set + +[ + temp-reg scan-reg 4 LDR ! load wrapper and advance + temp-reg dup wrapper@ <+> LDR ! load wrapped object + temp-reg ds-reg 4 STR ! push wrapped object +] { } make jit-push-wrapper set + +[ + R1 SP 4 SUB ! pass stack pointer to primitive +] { } make jit-word-primitive-jump set + +[ + R1 SP 4 SUB ! pass stack pointer to primitive +] { } make jit-word-primitive-call set + +: load-word-xt ( -- ) + word-reg scan-reg 4 LDR ! load word and advance + xt-reg word-reg word-xt@ <+> LDR ; + +: jit-call + scan-reg SP scan-save <+> STR ! save scan pointer + LR PC MOV ! save return address + xt-reg BX ! call + scan-reg SP scan-save <+> LDR ! restore scan pointer + ; + +: jit-jump + xt-reg BX ; + +[ load-word-xt jit-call ] { } make jit-word-call set + +[ load-word-xt jit-jump ] { } make jit-word-jump set + +: load-quot-xt + xt-reg quot-reg quot-xt@ <+> LDR ; + +: load-branch + temp-reg ds-reg 4 <-!> LDR ! pop boolean + temp-reg \ f tag-number CMP ! compare it with f + quot-reg scan-reg MOV ! point quot-reg at false branch + quot-reg dup 4 EQ ADD ! point quot-reg at true branch + quot-reg dup 4 <+> LDR ! load the branch + scan-reg dup 12 ADD ! advance scan pointer + load-quot-xt + ; + +[ + load-branch jit-jump +] { } make jit-if-jump set + +[ + load-branch jit-call +] { } make jit-if-call set + +[ + temp-reg ds-reg 4 <-!> LDR ! pop index + temp-reg dup 1 MOV ! turn it into an array offset + scan-reg dup 4 <+> LDR ! load array + temp-reg dup scan-reg ADD ! compute quotation location + quot-reg temp-reg array-start <+> LDR ! load quotation + load-quot-xt + jit-jump +] { } make jit-dispatch set + +[ + SP SP stack-frame ADD ! pop stack frame + LR SP 4 <-> LDR ! load return address +] { } make jit-epilog set + +[ LR BX ] { } make jit-return set + +[ "bootstrap.arm" forget-vocab ] with-compilation-unit diff --git a/arm/intrinsics/authors.txt b/arm/intrinsics/authors.txt new file mode 100644 index 0000000..1901f27 --- /dev/null +++ b/arm/intrinsics/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/arm/intrinsics/intrinsics.factor b/arm/intrinsics/intrinsics.factor new file mode 100644 index 0000000..d7ddd0c --- /dev/null +++ b/arm/intrinsics/intrinsics.factor @@ -0,0 +1,462 @@ +! Copyright (C) 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: alien arrays cpu.architecture cpu.arm.assembler +cpu.arm.architecture cpu.arm.allot kernel kernel.private math +math.private namespaces sequences words +quotations byte-arrays hashtables.private hashtables generator +generator.registers generator.fixup sequences.private sbufs +sbufs.private vectors vectors.private system +classes.tuple.private layouts strings.private slots.private ; +IN: cpu.arm.intrinsics + +: %slot-literal-known-tag + "val" operand + "obj" operand + "n" get cells + "obj" get operand-tag - <+/-> ; + +: %slot-literal-any-tag + "scratch" operand "obj" operand %untag + "val" operand "scratch" operand "n" get cells <+> ; + +: %slot-any + "scratch" operand "obj" operand %untag + "n" operand dup 1 MOV + "val" operand "scratch" operand "n" operand <+> ; + +\ slot { + ! Slot number is literal and the tag is known + { + [ %slot-literal-known-tag LDR ] H{ + { +input+ { { f "obj" known-tag } { [ small-slot? ] "n" } } } + { +scratch+ { { f "val" } } } + { +output+ { "val" } } + } + } + ! Slot number is literal + { + [ %slot-literal-any-tag LDR ] H{ + { +input+ { { f "obj" } { [ small-slot? ] "n" } } } + { +scratch+ { { f "scratch" } { f "val" } } } + { +output+ { "val" } } + } + } + ! Slot number in a register + { + [ %slot-any LDR ] H{ + { +input+ { { f "obj" } { f "n" } } } + { +scratch+ { { f "val" } { f "scratch" } } } + { +output+ { "val" } } + { +clobber+ { "n" } } + } + } +} define-intrinsics + +: %write-barrier ( -- ) + "val" get operand-immediate? "obj" get fresh-object? or [ + "cards_offset" f R12 %alien-global + "scratch" operand R12 "obj" operand card-bits ADD + "val" operand "scratch" operand 0 <+> LDRB + "val" operand dup card-mark ORR + "val" operand "scratch" operand 0 <+> STRB + ] unless ; + +\ set-slot { + ! Slot number is literal and tag is known + { + [ %slot-literal-known-tag STR %write-barrier ] H{ + { +input+ { { f "val" } { f "obj" known-tag } { [ small-slot? ] "n" } } } + { +scratch+ { { f "scratch" } } } + { +clobber+ { "val" } } + } + } + ! Slot number is literal + { + [ %slot-literal-any-tag STR %write-barrier ] H{ + { +input+ { { f "val" } { f "obj" } { [ small-slot? ] "n" } } } + { +scratch+ { { f "scratch" } } } + { +clobber+ { "val" } } + } + } + ! Slot number is in a register + { + [ %slot-any STR %write-barrier ] H{ + { +input+ { { f "val" } { f "obj" } { f "n" } } } + { +scratch+ { { f "scratch" } } } + { +clobber+ { "val" "n" } } + } + } +} define-intrinsics + +: fixnum-op ( op -- quot ) + [ "out" operand "x" operand "y" operand ] swap add ; + +: fixnum-register-op ( op -- pair ) + fixnum-op H{ + { +input+ { { f "x" } { f "y" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } + } 2array ; + +: fixnum-value-op ( op -- pair ) + fixnum-op H{ + { +input+ { { f "x" } { [ small-tagged? ] "y" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } + } 2array ; + +: define-fixnum-op ( word op -- ) + [ fixnum-value-op ] keep fixnum-register-op 2array + define-intrinsics ; + +{ + { fixnum+fast ADD } + { fixnum-fast SUB } + { fixnum-bitand AND } + { fixnum-bitor ORR } + { fixnum-bitxor EOR } +} [ + first2 define-fixnum-op +] each + +\ fixnum-bitnot [ + "x" operand dup MVN + "x" operand dup %untag +] H{ + { +input+ { { f "x" } } } + { +output+ { "x" } } +} define-intrinsic + +\ fixnum*fast [ + "out" operand "y" operand %untag-fixnum + "out" operand "x" operand "out" operand MUL +] H{ + { +input+ { { f "x" } { f "y" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +\ fixnum-shift [ + "out" operand "x" operand "y" get neg MOV + ! Mask off low bits + "out" operand dup %untag +] H{ + { +input+ { { f "x" } { [ -31 0 between? ] "y" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +: %untag-fixnums ( seq -- ) + [ dup %untag-fixnum ] unique-operands ; + +: overflow-check ( insn -- ) + [ + "end" define-label + [ "out" operand "x" operand "y" operand roll S execute ] keep + "end" get VC B + { "x" "y" } %untag-fixnums + "x" operand "x" operand "y" operand roll execute + "out" get "x" get %allot-bignum-signed-1 + "end" resolve-label + ] with-scope ; inline + +: overflow-template ( word insn -- ) + [ overflow-check ] curry H{ + { +input+ { { f "x" } { f "y" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } + { +clobber+ { "x" "y" } } + } define-intrinsic ; + +\ fixnum+ \ ADD overflow-template +\ fixnum- \ SUB overflow-template + +\ fixnum>bignum [ + "x" operand dup %untag-fixnum + "out" get "x" get %allot-bignum-signed-1 +] H{ + { +input+ { { f "x" } } } + { +scratch+ { { f "out" } } } + { +clobber+ { "x" } } + { +output+ { "out" } } +} define-intrinsic + +\ bignum>fixnum [ + "end" define-label + "x" operand dup %untag + "y" operand "x" operand cell <+> LDR + ! if the length is 1, its just the sign and nothing else, + ! so output 0 + "y" operand 1 v>operand CMP + "y" operand 0 EQ MOV + "end" get EQ B + ! load the value + "y" operand "x" operand 3 cells <+> LDR + ! load the sign + "x" operand "x" operand 2 cells <+> LDR + ! is the sign negative? + "x" operand 0 CMP + ! Negate the value + "y" operand "y" operand 0 NE RSB + "y" operand dup %tag-fixnum + "end" resolve-label +] H{ + { +input+ { { f "x" } } } + { +scratch+ { { f "y" } } } + { +clobber+ { "x" } } + { +output+ { "y" } } +} define-intrinsic + +: fixnum-jump ( op -- quo ) + [ "x" operand "y" operand CMP ] swap + 1quotation [ B ] 3append ; + +: fixnum-register-jump ( op -- pair ) + fixnum-jump { { f "x" } { f "y" } } 2array ; + +: fixnum-value-jump ( op -- pair ) + fixnum-jump { { f "x" } { [ small-tagged? ] "y" } } 2array ; + +: define-fixnum-jump ( word op -- ) + [ fixnum-value-jump ] keep fixnum-register-jump + 2array define-if-intrinsics ; + +{ + { fixnum< LT } + { fixnum<= LE } + { fixnum> GT } + { fixnum>= GE } + { eq? EQ } +} [ + first2 define-fixnum-jump +] each + +\ tag [ + "out" operand "in" operand tag-mask get AND + "out" operand dup %tag-fixnum +] H{ + { +input+ { { f "in" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +\ type [ + ! Get the tag + "out" operand "obj" operand tag-mask get AND + ! Compare with object tag number (3). + "out" operand object tag-number CMP + ! Tag the tag if it is not equal to 3 + "out" operand dup NE %tag-fixnum + ! Load the object header if tag is equal to 3 + "out" operand "obj" operand object tag-number <-> EQ LDR +] H{ + { +input+ { { f "obj" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +\ class-hash [ + "end" define-label + ! Get the tag + "out" operand "obj" operand tag-mask get AND + ! Compare with tuple tag number (2). + "out" operand tuple tag-number CMP + "out" operand "obj" operand tuple-class-offset <+/-> EQ LDR + "out" operand dup class-hash-offset <+/-> EQ LDR + "end" get EQ B + ! Compare with object tag number (3). + "out" operand object tag-number CMP + "out" operand "obj" operand object tag-number <-> EQ LDR + ! Tag the tag + "out" operand dup NE %tag-fixnum + "end" resolve-label +] H{ + { +input+ { { f "obj" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +: userenv ( reg -- ) + ! Load the userenv pointer in a register. + "userenv" f rot compile-dlsym ; + +\ getenv [ + "n" operand dup 1 MOV + "x" operand userenv + "x" operand "x" operand "n" operand <+> LDR +] H{ + { +input+ { { f "n" } } } + { +scratch+ { { f "x" } } } + { +output+ { "x" } } + { +clobber+ { "n" } } +} define-intrinsic + +\ setenv [ + "n" operand dup 1 MOV + "x" operand userenv + "val" operand "x" operand "n" operand <+> STR +] H{ + { +input+ { { f "val" } { f "n" } } } + { +scratch+ { { f "x" } } } + { +clobber+ { "n" } } +} define-intrinsic + +: %set-slot R11 swap cells <+> STR ; + +: %store-length + R12 "n" operand MOV + R12 1 %set-slot ; + +: %fill-array swap 2 + %set-slot ; + +\ [ + tuple "n" get 2 + cells %allot + %store-length + ! Store class + "class" operand 2 %set-slot + ! Zero out the rest of the tuple + "initial" operand f v>operand MOV + "n" get 1- [ 1+ "initial" operand %fill-array ] each + "out" get tuple %store-tagged +] H{ + { +input+ { { f "class" } { [ inline-array? ] "n" } } } + { +scratch+ { { f "out" } { f "initial" } } } + { +output+ { "out" } } +} define-intrinsic + +\ [ + array "n" get 2 + cells %allot + %store-length + ! Store initial element + "n" get [ "initial" operand %fill-array ] each + "out" get object %store-tagged +] H{ + { +input+ { { [ inline-array? ] "n" } { f "initial" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +\ [ + byte-array "n" get 2 cells + %allot + %store-length + ! Store initial element + R12 0 MOV + "n" get cell align cell /i [ R12 %fill-array ] each + "out" get object %store-tagged +] H{ + { +input+ { { [ inline-array? ] "n" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +\ [ + ratio 3 cells %allot + "numerator" operand 1 %set-slot + "denominator" operand 2 %set-slot + "out" get ratio %store-tagged +] H{ + { +input+ { { f "numerator" } { f "denominator" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +\ [ + complex 3 cells %allot + "real" operand 1 %set-slot + "imaginary" operand 2 %set-slot + ! Store tagged ptr in reg + "out" get complex %store-tagged +] H{ + { +input+ { { f "real" } { f "imaginary" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +\ [ + wrapper 2 cells %allot + "obj" operand 1 %set-slot + ! Store tagged ptr in reg + "out" get object %store-tagged +] H{ + { +input+ { { f "obj" } } } + { +scratch+ { { f "out" } } } + { +output+ { "out" } } +} define-intrinsic + +! Alien intrinsics +: %alien-accessor ( quot -- ) + "offset" operand dup %untag-fixnum + "offset" operand dup "alien" operand ADD + "value" operand "offset" operand 0 <+> roll call ; inline + +: alien-integer-get-template + H{ + { +input+ { + { unboxed-c-ptr "alien" c-ptr } + { f "offset" fixnum } + } } + { +scratch+ { { f "value" } } } + { +output+ { "value" } } + { +clobber+ { "offset" } } + } ; + +: %alien-integer-get ( quot -- ) + %alien-accessor + "value" operand dup %tag-fixnum ; inline + +: alien-integer-set-template + H{ + { +input+ { + { f "value" fixnum } + { unboxed-c-ptr "alien" c-ptr } + { f "offset" fixnum } + } } + { +clobber+ { "value" "offset" } } + } ; + +: %alien-integer-set ( quot -- ) + "offset" get "value" get = [ + "value" operand dup %untag-fixnum + ] unless + %alien-accessor ; inline + +: define-alien-integer-intrinsics ( word get-quot word set-quot -- ) + [ %alien-integer-set ] curry + alien-integer-set-template + define-intrinsic + [ %alien-integer-get ] curry + alien-integer-get-template + define-intrinsic ; + +\ alien-unsigned-1 [ LDRB ] +\ set-alien-unsigned-1 [ STRB ] +define-alien-integer-intrinsics + +: alien-cell-template + H{ + { +input+ { + { unboxed-c-ptr "alien" c-ptr } + { f "offset" fixnum } + } } + { +scratch+ { { unboxed-alien "value" } } } + { +output+ { "value" } } + { +clobber+ { "offset" } } + } ; + +\ alien-cell +[ [ LDR ] %alien-accessor ] +alien-cell-template define-intrinsic + +: set-alien-cell-template + H{ + { +input+ { + { unboxed-c-ptr "value" pinned-c-ptr } + { unboxed-c-ptr "alien" c-ptr } + { f "offset" fixnum } + } } + { +clobber+ { "offset" } } + } ; + +\ set-alien-cell +[ [ STR ] %alien-accessor ] +set-alien-cell-template define-intrinsic diff --git a/arm/summary.txt b/arm/summary.txt new file mode 100644 index 0000000..f3e46d9 --- /dev/null +++ b/arm/summary.txt @@ -0,0 +1 @@ +ARM3 compiler backend diff --git a/arm/tags.txt b/arm/tags.txt new file mode 100644 index 0000000..86a7c8e --- /dev/null +++ b/arm/tags.txt @@ -0,0 +1 @@ +compiler diff --git a/automata/authors.txt b/automata/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/automata/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/automata/automata.factor b/automata/automata.factor new file mode 100644 index 0000000..35f02f8 --- /dev/null +++ b/automata/automata.factor @@ -0,0 +1,98 @@ + +USING: kernel math math.parser random arrays hashtables assocs sequences + grouping vars ; + +IN: automata + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! set-rule +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VAR: rule VAR: rule-number + +: init-rule ( -- ) 8 >rule ; + +: rule-keys ( -- array ) + { { 1 1 1 } + { 1 1 0 } + { 1 0 1 } + { 1 0 0 } + { 0 1 1 } + { 0 1 0 } + { 0 0 1 } + { 0 0 0 } } ; + +: rule-values ( n -- seq ) >bin 8 CHAR: 0 pad-head string>digits ; + +: set-rule ( n -- ) + dup >rule-number rule-values rule-keys [ rule> set-at ] 2each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! step-capped-line +! step-wrapped-line +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: pattern>state ( {_a_b_c_} -- state ) rule> at ; + +: cap-line ( line -- 0-line-0 ) { 0 } prepend { 0 } append ; + +: wrap-line ( a-line-z -- za-line-za ) + dup peek 1array swap dup first 1array append append ; + +: step-line ( line -- new-line ) 3 [ pattern>state ] map ; + +: step-capped-line ( line -- new-line ) cap-line step-line ; +: step-wrapped-line ( line -- new-line ) wrap-line step-line ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VARS: width height ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: random-line ( -- line ) width> [ drop 2 random ] map ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: center-i ( -- i ) width> 2 / >fixnum ; + +: center-line ( -- line ) center-i width> [ = 1 0 ? ] with map ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: interesting ( -- seq ) + { 18 22 26 30 41 45 54 60 73 75 82 86 89 90 97 101 102 105 106 107 109 + 110 120 121 122 124 126 129 137 146 147 149 150 151 153 154 161 165 } ; + +: mild ( -- seq ) { 6 9 11 57 62 74 118 } ; + +: set-interesting ( -- ) interesting random set-rule ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VAR: bitmap + +VAR: last-line + +: run-rule ( -- ) + last-line> height> [ drop step-capped-line dup ] map >bitmap >last-line ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: start-random ( -- ) random-line >last-line run-rule ; + +: start-center ( -- ) center-line >last-line run-rule ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! VAR: loop-flag + +! DEFER: loop + +! : (loop) ( -- ) run-rule 3000 sleep loop ; + +! : loop ( -- ) loop-flag> [ (loop) ] [ ] if ; + +! : start-loop ( -- ) t >loop-flag [ loop ] in-thread ; + +! : stop-loop ( -- ) f >loop-flag ; diff --git a/automata/summary.txt b/automata/summary.txt new file mode 100644 index 0000000..a01a8c7 --- /dev/null +++ b/automata/summary.txt @@ -0,0 +1 @@ +Cellular Automata Explorer (one dimensional, two state) diff --git a/automata/ui/authors.txt b/automata/ui/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/automata/ui/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/automata/ui/deploy.factor b/automata/ui/deploy.factor new file mode 100644 index 0000000..12861cf --- /dev/null +++ b/automata/ui/deploy.factor @@ -0,0 +1,12 @@ +USING: tools.deploy.config ; +V{ + { deploy-ui? t } + { deploy-io 1 } + { deploy-reflection 1 } + { deploy-compiler? t } + { deploy-math? t } + { deploy-word-props? f } + { deploy-c-types? f } + { "stop-after-last-window?" t } + { deploy-name "Cellular Automata" } +} diff --git a/automata/ui/tags.txt b/automata/ui/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/automata/ui/tags.txt @@ -0,0 +1 @@ +demos diff --git a/automata/ui/ui.factor b/automata/ui/ui.factor new file mode 100644 index 0000000..def71e7 --- /dev/null +++ b/automata/ui/ui.factor @@ -0,0 +1,100 @@ + +USING: kernel namespaces math quotations arrays hashtables sequences threads + opengl + opengl.gl + colors + ui + ui.gestures + ui.gadgets + ui.gadgets.slate + ui.gadgets.labels + ui.gadgets.buttons + ui.gadgets.frames + ui.gadgets.packs + ui.gadgets.grids + ui.gadgets.theme + ui.gadgets.handler + accessors + vars fry + rewrite-closures automata math.geometry.rect newfx ; + +IN: automata.ui + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: draw-point ( y x value -- ) 1 = [ swap glVertex2i ] [ 2drop ] if ; + +: draw-line ( y line -- ) 0 swap [ [ 2dup ] dip draw-point 1+ ] each 2drop ; + +: (draw-bitmap) ( bitmap -- ) 0 swap [ [ dup ] dip draw-line 1+ ] each drop ; + +: draw-bitmap ( bitmap -- ) GL_POINTS glBegin (draw-bitmap) glEnd ; + +: display ( -- ) black gl-color bitmap> draw-bitmap ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VAR: slate + +! Call a 'model' quotation with the current 'view'. + +: with-view ( quot -- ) + slate> rect-dim first >width + slate> rect-dim second >height + call + slate> relayout-1 ; + +! Create a quotation that is appropriate for buttons and gesture handler. + +: view-action ( quot -- quot ) '[ drop _ with-view ] closed-quot ; + +: view-button ( label quot -- button ) [ ] dip view-action ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! Helper word to make things less verbose + +: random-rule ( -- ) set-interesting start-center ; + +DEFER: automata-window + +: automata-window* ( -- ) + init-rule + set-interesting + + + + + + "1 - Center" [ start-center ] view-button add-gadget + "2 - Random" [ start-random ] view-button add-gadget + "3 - Continue" [ run-rule ] view-button add-gadget + "5 - Random Rule" [ random-rule ] view-button add-gadget + "n - New" [ automata-window ] view-button add-gadget + + @top grid-add + + C[ display ] + { 400 400 } >>pdim + dup >slate + + @center grid-add + + + + H{ } + T{ key-down f f "1" } [ start-center ] view-action is + T{ key-down f f "2" } [ start-random ] view-action is + T{ key-down f f "3" } [ run-rule ] view-action is + T{ key-down f f "5" } [ random-rule ] view-action is + T{ key-down f f "n" } [ automata-window ] view-action is + + >>table + + "Automata" open-window ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: automata-window ( -- ) [ [ automata-window* ] with-scope ] with-ui ; + +MAIN: automata-window diff --git a/boolean-expr/authors.txt b/boolean-expr/authors.txt new file mode 100644 index 0000000..1901f27 --- /dev/null +++ b/boolean-expr/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/boolean-expr/boolean-expr.factor b/boolean-expr/boolean-expr.factor new file mode 100644 index 0000000..33e5e92 --- /dev/null +++ b/boolean-expr/boolean-expr.factor @@ -0,0 +1,95 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays classes kernel sequences sets +io prettyprint multi-methods ; +IN: boolean-expr + +! Demonstrates the use of Unicode symbols in source files, and +! multi-method dispatch. + +TUPLE: â x y ; +TUPLE: â x y ; +TUPLE: Â¬ x ; + +SINGLETONS: â¤ â¥ ; + +SINGLETONS: P Q R S T U V W X Y Z ; + +UNION: â¡ â â Â¬ â¤ â¥ P Q R S T U V W X Y Z ; + +GENERIC: â ( x y -- expr ) + +METHOD: â { â¤ â¡ } nip ; +METHOD: â { â¡ â¤ } drop ; +METHOD: â { â¥ â¡ } drop ; +METHOD: â { â¡ â¥ } nip ; + +METHOD: â { â â¡ } [ [ x>> ] dip â ] [ [ y>> ] dip â ] 2bi â ; +METHOD: â { â¡ â } [ x>> â ] [ y>> â ] 2bi â ; + +METHOD: â { â¡ â¡ } \ â boa ; + +GENERIC: â ( x y -- expr ) + +METHOD: â { â¤ â¡ } drop ; +METHOD: â { â¡ â¤ } nip ; +METHOD: â { â¥ â¡ } nip ; +METHOD: â { â¡ â¥ } drop ; + +METHOD: â { â¡ â¡ } \ â boa ; + +GENERIC: Â¬ ( x -- expr ) + +METHOD: Â¬ { â¤ } drop â¥ ; +METHOD: Â¬ { â¥ } drop â¤ ; + +METHOD: Â¬ { â } [ x>> Â¬ ] [ y>> Â¬ ] bi â ; +METHOD: Â¬ { â } [ x>> Â¬ ] [ y>> Â¬ ] bi â ; + +METHOD: Â¬ { â¡ } \ Â¬ boa ; + +: â ( x y -- expr ) Â¬ â ; +: â ( x y -- expr ) [ â ] [ â Â¬ ] 2bi â ; +: â£ ( x y -- expr ) [ â ] [ [ Â¬ ] bi@ â ] 2bi â ; + +GENERIC: (cnf) ( expr -- cnf ) + +METHOD: (cnf) { â } [ x>> (cnf) ] [ y>> (cnf) ] bi append ; +METHOD: (cnf) { â¡ } 1array ; + +GENERIC: cnf ( expr -- cnf ) + +METHOD: cnf { â } [ x>> cnf ] [ y>> cnf ] bi append ; +METHOD: cnf { â¡ } (cnf) 1array ; + +GENERIC: satisfiable? ( expr -- ? ) + +METHOD: satisfiable? { â¤ } drop t ; +METHOD: satisfiable? { â¥ } drop f ; + +: partition ( seq quot -- left right ) + [ [ not ] compose filter ] [ filter ] 2bi ; inline + +: (satisfiable?) ( seq -- ? ) + [ \ Â¬ instance? ] partition [ x>> ] map intersect empty? ; + +METHOD: satisfiable? { â¡ } + cnf [ (satisfiable?) ] any? ; + +GENERIC: (expr.) ( expr -- ) + +METHOD: (expr.) { â¡ } pprint ; + +: op. ( expr -- ) + "(" write + [ x>> (expr.) ] + [ bl class pprint bl ] + [ y>> (expr.) ] + tri + ")" write ; + +METHOD: (expr.) { â } op. ; +METHOD: (expr.) { â } op. ; +METHOD: (expr.) { Â¬ } [ class pprint ] [ x>> (expr.) ] bi ; + +: expr. ( expr -- ) (expr.) nl ; diff --git a/boolean-expr/summary.txt b/boolean-expr/summary.txt new file mode 100644 index 0000000..9b51186 --- /dev/null +++ b/boolean-expr/summary.txt @@ -0,0 +1 @@ +Simple boolean expression evaluator and simplifier diff --git a/bubble-chamber/bubble-chamber.factor b/bubble-chamber/bubble-chamber.factor new file mode 100644 index 0000000..914dd77 --- /dev/null +++ b/bubble-chamber/bubble-chamber.factor @@ -0,0 +1,652 @@ + +USING: kernel syntax accessors sequences + arrays calendar + combinators.cleave combinators.short-circuit + locals math math.constants math.functions math.libm + math.order math.points math.vectors + namespaces random sequences threads ui ui.gadgets ui.gestures + math.ranges + colors + colors.gray + vars + multi-methods + multi-method-syntax + processing.shapes + frame-buffer ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +IN: bubble-chamber + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! This is a Factor implementation of an art piece by Jared Tarbell: +! +! http://complexification.net/gallery/machines/bubblechamber/ +! +! Jared's version is written in Processing (Java) + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! processing +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: 2random ( a b -- num ) 2dup swap - 100 / random ; + +: 1random ( b -- num ) 0 swap 2random ; + +: at-fraction ( seq fraction -- val ) over length 1- * swap nth ; + +: at-fraction-of ( fraction seq -- val ) swap at-fraction ; + +: mouse ( -- point ) hand-loc get ; + +: mouse-x ( -- x ) mouse first ; +: mouse-y ( -- y ) mouse second ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +GENERIC: collide ( particle -- ) +GENERIC: move ( particle -- ) + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: particle + bubble-chamber pos vel speed speed-d theta theta-d theta-dd myc mya ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: initialize-particle ( particle -- particle ) + + 0 0 {2} >>pos + 0 0 {2} >>vel + + 0 >>speed + 0 >>speed-d + 0 >>theta + 0 >>theta-d + 0 >>theta-dd + + 0 0 0 1 rgba boa >>myc + 0 0 0 1 rgba boa >>mya ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: center ( particle -- point ) bubble-chamber>> size>> 2 v/n ; + +DEFER: collision-theta + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: move-by ( obj delta -- obj ) over pos>> v+ >>pos ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: theta-dd-small? ( par limit -- par ? ) [ dup theta-dd>> abs ] dip < ; + +: random-theta-dd ( par a b -- par ) 2random >>theta-dd ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: turn ( particle -- particle ) + dup + [ speed>> ] [ theta>> { sin cos } ] bi n*v + >>vel ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: step-theta ( p -- p ) [ ] [ theta>> ] [ theta-d>> ] tri + >>theta ; +: step-theta-d ( p -- p ) [ ] [ theta-d>> ] [ theta-dd>> ] tri + >>theta-d ; +: step-speed-sub ( p -- p ) [ ] [ speed>> ] [ speed-d>> ] tri - >>speed ; +: step-speed-mul ( p -- p ) [ ] [ speed>> ] [ speed-d>> ] tri * >>speed ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: out-of-bounds? ( PARTICLE -- ? ) + [let | X [ PARTICLE pos>> first ] + Y [ PARTICLE pos>> second ] + WIDTH [ PARTICLE bubble-chamber>> size>> first ] + HEIGHT [ PARTICLE bubble-chamber>> size>> second ] | + + [let | LEFT [ WIDTH neg ] + RIGHT [ WIDTH 2 * ] + BOTTOM [ HEIGHT neg ] + TOP [ HEIGHT 2 * ] | + + { [ X LEFT < ] [ X RIGHT > ] [ Y BOTTOM < ] [ Y TOP > ] } 0|| ] ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle.axion +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < particle ; + +: axion ( -- ) new initialize-particle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: collide ( -- ) + + dup center >>pos + 2 pi * 1random >>theta + 1.0 6.0 2random >>speed + 0.998 1.000 2random >>speed-d + 0 >>theta-d + 0 >>theta-dd + + [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while + + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: dy>alpha ( dy -- alpha ) neg 6 * 30 + 255.0 / ; + +! : axion-white ( dy -- dy ) dup 1 swap dy>alpha {2} \ stroke-color set ; +! : axion-black ( dy -- dy ) dup 0 swap dy>alpha {2} \ stroke-color set ; + +: axion-white ( dy -- dy ) dup 1 swap dy>alpha gray boa \ stroke-color set ; +: axion-black ( dy -- dy ) dup 0 swap dy>alpha gray boa \ stroke-color set ; + +: axion-point- ( particle dy -- particle ) [ dup pos>> ] dip v-y point ; +: axion-point+ ( particle dy -- particle ) [ dup pos>> ] dip v+y point ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: move ( -- ) + + T{ gray f 0.06 0.59 } \ stroke-color set + dup pos>> point + + 1 4 [a,b] [ axion-white axion-point- ] each + 1 4 [a,b] [ axion-black axion-point+ ] each + + dup vel>> move-by + + turn + + step-theta + step-theta-d + step-speed-mul + + [ ] [ speed-d>> 0.9999 * ] bi >>speed-d + + 1000 random 996 > + [ + dup speed>> neg >>speed + dup speed-d>> neg 2 + >>speed-d + + 100 random 30 > [ collide ] [ drop ] if + ] + [ drop ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle.hadron +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < particle ; + +: hadron ( -- ) new initialize-particle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: collide ( -- ) + + dup center >>pos + 2 pi * 1random >>theta + 0.5 3.5 2random >>speed + 0.996 1.001 2random >>speed-d + 0 >>theta-d + 0 >>theta-dd + + [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while + + 0 1 0 1 rgba boa >>myc + + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: move ( -- ) + + T{ gray f 1 0.11 } \ stroke-color set dup pos>> 1 v-y point + T{ gray f 0 0.11 } \ stroke-color set dup pos>> 1 v+y point + + dup vel>> move-by + + turn + + step-theta + step-theta-d + step-speed-mul + + 1000 random 997 > + [ + 1.0 >>speed-d + 0.00001 >>theta-dd + + 100 random 70 > [ dup collide ] when + ] + when + + dup out-of-bounds? [ collide ] [ drop ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle.muon.colors +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: good-colors ( -- seq ) + { + T{ rgba f 0.23 0.14 0.17 1 } + T{ rgba f 0.23 0.14 0.15 1 } + T{ rgba f 0.21 0.14 0.15 1 } + T{ rgba f 0.51 0.39 0.33 1 } + T{ rgba f 0.49 0.33 0.20 1 } + T{ rgba f 0.55 0.45 0.32 1 } + T{ rgba f 0.69 0.63 0.51 1 } + T{ rgba f 0.64 0.39 0.18 1 } + T{ rgba f 0.73 0.42 0.20 1 } + T{ rgba f 0.71 0.45 0.29 1 } + T{ rgba f 0.79 0.45 0.22 1 } + T{ rgba f 0.82 0.56 0.34 1 } + T{ rgba f 0.88 0.72 0.49 1 } + T{ rgba f 0.85 0.69 0.40 1 } + T{ rgba f 0.96 0.92 0.75 1 } + T{ rgba f 0.99 0.98 0.87 1 } + T{ rgba f 0.85 0.82 0.69 1 } + T{ rgba f 0.99 0.98 0.87 1 } + T{ rgba f 0.82 0.82 0.79 1 } + T{ rgba f 0.65 0.69 0.67 1 } + T{ rgba f 0.53 0.60 0.55 1 } + T{ rgba f 0.57 0.53 0.68 1 } + T{ rgba f 0.47 0.42 0.56 1 } + } ; + +: anti-colors ( -- seq ) good-colors ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: color-fraction ( particle -- particle fraction ) dup theta>> pi + 2 pi * / ; + +: set-good-color ( particle -- particle ) + color-fraction dup 0 1 between? + [ good-colors at-fraction-of >>myc ] + [ drop ] + if ; + +: set-anti-color ( particle -- particle ) + color-fraction dup 0 1 between? + [ anti-colors at-fraction-of >>mya ] + [ drop ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle.muon +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < particle ; + +: muon ( -- ) new initialize-particle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: collide ( -- ) + + dup center >>pos + 2 32 [a,b] random >>speed + 0.0001 0.001 2random >>speed-d + + dup collision-theta -0.1 0.1 2random + >>theta + 0 >>theta-d + 0 >>theta-dd + + [ 0.001 theta-dd-small? ] [ -0.1 0.1 random-theta-dd ] while + + set-good-color + set-anti-color + + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: move ( -- ) + + [let | MUON [ ] | + + [let | WIDTH [ MUON bubble-chamber>> size>> first ] | + + MUON + + dup myc>> 0.16 >>alpha \ stroke-color set + dup pos>> point + + dup mya>> 0.16 >>alpha \ stroke-color set + dup pos>> first2 [ WIDTH swap - ] dip 2array point + + dup + [ speed>> ] [ theta>> { sin cos } ] bi n*v + move-by + + step-theta + step-theta-d + step-speed-sub + + dup out-of-bounds? [ collide ] [ drop ] if ] ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! bubble-chamber.particle.quark +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < particle ; + +: quark ( -- ) new initialize-particle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: collide ( -- ) + + dup center >>pos + dup collision-theta -0.11 0.11 2random + >>theta + 0.5 3.0 2random >>speed + + 0.996 1.001 2random >>speed-d + 0 >>theta-d + 0 >>theta-dd + + [ 0.00001 theta-dd-small? ] [ -0.001 0.001 random-theta-dd ] while + + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +METHOD: move ( -- ) + + [let | QUARK [ ] | + + [let | WIDTH [ QUARK bubble-chamber>> size>> first ] | + + QUARK + + dup myc>> 0.13 >>alpha \ stroke-color set + dup pos>> point + + dup pos>> first2 [ WIDTH swap - ] dip 2array point + + [ ] [ vel>> ] bi move-by + + turn + + step-theta + step-theta-d + step-speed-mul + + 1000 random 997 > + [ + dup speed>> neg >>speed + 2 over speed-d>> - >>speed-d + ] + when + + dup out-of-bounds? [ collide ] [ drop ] if ] ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USE: syntax ! Switch back to non-multi-method 'TUPLE:' syntax + +TUPLE: < + paused particles collision-theta size ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! : randomize-collision-theta ( bubble-chamber -- bubble-chamber ) +! 0 2 pi * 0.001 random >>collision-theta ; + +: randomize-collision-theta ( bubble-chamber -- bubble-chamber ) + pi neg pi 0.001 random >>collision-theta ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: collision-theta ( particle -- theta ) bubble-chamber>> collision-theta>> ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M: pref-dim* ( gadget -- dim ) size>> ; + +M: ungraft* ( -- ) t >>paused drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: iterate-particle ( particle -- ) move ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M:: update-frame-buffer ( BUBBLE-CHAMBER -- ) + + BUBBLE-CHAMBER particles>> [ iterate-particle ] each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: iterate-system ( -- ) drop ; + +:: start-bubble-chamber-thread ( GADGET -- ) + GADGET f >>paused drop + [ + [ + GADGET paused>> + [ f ] + [ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ] + if + ] + loop + ] + in-thread ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: bubble-chamber ( -- ) + new-gadget + { 1000 1000 } >>size + randomize-collision-theta ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: bubble-chamber-window ( -- ) + bubble-chamber + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: add-particle ( BUBBLE-CHAMBER PARTICLE -- bubble-chamber ) + + PARTICLE BUBBLE-CHAMBER >>bubble-chamber drop + + BUBBLE-CHAMBER BUBBLE-CHAMBER particles>> PARTICLE suffix >>particles ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: mouse->collision-theta ( BUBBLE-CHAMBER -- BUBBLE-CHAMBER ) + mouse + BUBBLE-CHAMBER size>> 2 v/n + v- + first2 + fatan2 + BUBBLE-CHAMBER collision-theta<< + BUBBLE-CHAMBER ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: mouse-pressed ( BUBBLE-CHAMBER -- ) + + BUBBLE-CHAMBER mouse->collision-theta drop + + 11 + [ + BUBBLE-CHAMBER particles>> [ ? ] filter random [ collide ] when* + BUBBLE-CHAMBER particles>> [ ? ] filter random [ collide ] when* + BUBBLE-CHAMBER particles>> [ ? ] filter random [ collide ] when* + ] + times ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + H{ { T{ button-down } [ mouse-pressed ] } } set-gestures + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: collide-random-particle ( bubble-chamber -- bubble-chamber ) + dup particles>> random collide ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: big-bang ( bubble-chamber -- bubble-chamber ) + dup particles>> [ collide ] each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: collide-one-of-each ( bubble-chamber -- bubble-chamber ) + dup + particles>> + [ [ ? ] filter random collide ] + [ [ ? ] filter random collide ] + [ [ ? ] filter random collide ] + tri ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Some initial configurations +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: ten-hadrons ( -- ) + bubble-chamber-window + 10 [ drop hadron add-particle ] each + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: original ( -- ) + + bubble-chamber-window + + 1789 [ muon add-particle ] times + 1300 [ quark add-particle ] times + 1000 [ hadron add-particle ] times + 111 [ axion add-particle ] times + + particles>> + [ [ ? ] filter random collide ] + [ [ ? ] filter random collide ] + [ [ ? ] filter random collide ] + tri ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: hadron-chamber ( -- ) + bubble-chamber-window + 1000 [ hadron add-particle ] times + big-bang + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: quark-chamber ( -- ) + bubble-chamber-window + 100 [ quark add-particle ] times + big-bang + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: small ( -- ) + new-gadget + { 200 200 } >>size + randomize-collision-theta + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window + + 42 [ muon add-particle ] times + 30 [ quark add-particle ] times + 21 [ hadron add-particle ] times + 7 [ axion add-particle ] times + + collide-one-of-each + + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: medium ( -- ) + new-gadget + { 400 400 } >>size + randomize-collision-theta + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window + + 100 [ muon add-particle ] times + 81 [ quark add-particle ] times + 60 [ hadron add-particle ] times + 9 [ axion add-particle ] times + + collide-one-of-each + + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: large ( -- ) + new-gadget + { 600 600 } >>size + randomize-collision-theta + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window + + 550 [ muon add-particle ] times + 339 [ quark add-particle ] times + 100 [ hadron add-particle ] times + 11 [ axion add-particle ] times + + collide-one-of-each + + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Experimental +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: muon-chamber ( -- ) + bubble-chamber-window + 1000 [ muon add-particle ] times + dup particles>> [ collide randomize-collision-theta ] each + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: original-big-bang ( -- ) + bubble-chamber + { 1000 1000 } >>size + dup start-bubble-chamber-thread + dup "Bubble Chamber" open-window + + 1789 [ muon add-particle ] times + 1300 [ quark add-particle ] times + 1000 [ hadron add-particle ] times + 111 [ axion add-particle ] times + + big-bang + + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: original-big-bang-variant ( -- ) + bubble-chamber-window + 1789 [ muon add-particle ] times + 1300 [ quark add-particle ] times + 1000 [ hadron add-particle ] times + 111 [ axion add-particle ] times + dup particles>> [ collide randomize-collision-theta ] each + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/bubble-chamber/hadron-chamber/hadron-chamber.factor b/bubble-chamber/hadron-chamber/hadron-chamber.factor new file mode 100644 index 0000000..092dd1e --- /dev/null +++ b/bubble-chamber/hadron-chamber/hadron-chamber.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.hadron-chamber + +: main ( -- ) [ hadron-chamber ] with-ui ; + +MAIN: main diff --git a/bubble-chamber/hadron-chamber/tags.txt b/bubble-chamber/hadron-chamber/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/bubble-chamber/hadron-chamber/tags.txt @@ -0,0 +1 @@ +demos diff --git a/bubble-chamber/large/large.factor b/bubble-chamber/large/large.factor new file mode 100644 index 0000000..aef9d38 --- /dev/null +++ b/bubble-chamber/large/large.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.large + +: main ( -- ) [ large ] with-ui ; + +MAIN: main diff --git a/bubble-chamber/large/tags.txt b/bubble-chamber/large/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/bubble-chamber/large/tags.txt @@ -0,0 +1 @@ +demos diff --git a/bubble-chamber/medium/medium.factor b/bubble-chamber/medium/medium.factor new file mode 100644 index 0000000..a72ca1c --- /dev/null +++ b/bubble-chamber/medium/medium.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.medium + +: main ( -- ) [ medium ] with-ui ; + +MAIN: main diff --git a/bubble-chamber/medium/tags.txt b/bubble-chamber/medium/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/bubble-chamber/medium/tags.txt @@ -0,0 +1 @@ +demos diff --git a/bubble-chamber/original/original.factor b/bubble-chamber/original/original.factor new file mode 100644 index 0000000..4940957 --- /dev/null +++ b/bubble-chamber/original/original.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.original + +: main ( -- ) [ original ] with-ui ; + +MAIN: main diff --git a/bubble-chamber/original/tags.txt b/bubble-chamber/original/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/bubble-chamber/original/tags.txt @@ -0,0 +1 @@ +demos diff --git a/bubble-chamber/quark-chamber/quark-chamber.factor b/bubble-chamber/quark-chamber/quark-chamber.factor new file mode 100644 index 0000000..97aaebe --- /dev/null +++ b/bubble-chamber/quark-chamber/quark-chamber.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.quark-chamber + +: main ( -- ) [ quark-chamber ] with-ui ; + +MAIN: main diff --git a/bubble-chamber/quark-chamber/tags.txt b/bubble-chamber/quark-chamber/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/bubble-chamber/quark-chamber/tags.txt @@ -0,0 +1 @@ +demos diff --git a/bubble-chamber/small/small.factor b/bubble-chamber/small/small.factor new file mode 100644 index 0000000..774a2bc --- /dev/null +++ b/bubble-chamber/small/small.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.small + +: main ( -- ) [ small ] with-ui ; + +MAIN: main diff --git a/bubble-chamber/small/tags.txt b/bubble-chamber/small/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/bubble-chamber/small/tags.txt @@ -0,0 +1 @@ +demos diff --git a/bubble-chamber/ten-hadrons/tags.txt b/bubble-chamber/ten-hadrons/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/bubble-chamber/ten-hadrons/tags.txt @@ -0,0 +1 @@ +demos diff --git a/bubble-chamber/ten-hadrons/ten-hadrons.factor b/bubble-chamber/ten-hadrons/ten-hadrons.factor new file mode 100644 index 0000000..7eb6673 --- /dev/null +++ b/bubble-chamber/ten-hadrons/ten-hadrons.factor @@ -0,0 +1,8 @@ + +USING: ui bubble-chamber ; + +IN: bubble-chamber.ten-hadrons + +: main ( -- ) [ ten-hadrons ] with-ui ; + +MAIN: main diff --git a/cartesian/cartesian.factor b/cartesian/cartesian.factor new file mode 100644 index 0000000..730b0f5 --- /dev/null +++ b/cartesian/cartesian.factor @@ -0,0 +1,42 @@ + +USING: kernel combinators sequences opengl.gl + ui.render ui.gadgets ui.gadgets.slate + accessors ; + +IN: ui.gadgets.cartesian + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: cartesian < slate x-min x-max y-min y-max z-min z-max perspective ; + +: init-cartesian ( cartesian -- cartesian ) + init-slate + -10 >>x-min + 10 >>x-max + -10 >>y-min + 10 >>y-max + -1 >>z-min + 1 >>z-max ; + +: ( -- cartesian ) cartesian new init-cartesian ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M: cartesian establish-coordinate-system ( cartesian -- cartesian ) + dup + { + [ x-min>> ] [ x-max>> ] + [ y-min>> ] [ y-max>> ] + [ z-min>> ] [ z-max>> ] + } + cleave + glOrtho ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: x-range ( cartesian range -- cartesian ) first2 [ >>x-min ] [ >>x-max ] bi* ; +: y-range ( cartesian range -- cartesian ) first2 [ >>y-min ] [ >>y-max ] bi* ; +: z-range ( cartesian range -- cartesian ) first2 [ >>z-min ] [ >>z-max ] bi* ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/cfdg/authors.txt b/cfdg/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/cfdg/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/cfdg/cfdg.factor b/cfdg/cfdg.factor new file mode 100644 index 0000000..834b4b1 --- /dev/null +++ b/cfdg/cfdg.factor @@ -0,0 +1,262 @@ + +USING: kernel alien.c-types combinators namespaces make arrays + sequences splitting + math math.functions math.vectors math.trig + opengl.gl opengl.glu opengl ui ui.gadgets.slate + vars colors self self.slots + random-weighted colors.hsv cfdg.gl accessors + ui.gadgets.handler ui.gestures assocs ui.gadgets macros + specialized-arrays.double ; + +QUALIFIED: syntax + +IN: cfdg + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SELF-SLOTS: hsva + +: clear-color ( color -- ) gl-clear-color GL_COLOR_BUFFER_BIT glClear ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! if (adjustment < 0) +! base + base * adjustment + +! if (adjustment > 0) +! base + (1 - base) * adjustment + +: adjust ( val num -- val ) dup 0 > [ 1 pick - * + ] [ dupd * + ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: hue ( num -- ) hue-> + 360 mod ->hue ; + +: saturation ( num -- ) saturation-> swap adjust ->saturation ; +: brightness ( num -- ) value-> swap adjust ->value ; +: alpha ( num -- ) alpha-> swap adjust ->alpha ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: h ( num -- ) hue ; +: sat ( num -- ) saturation ; +: b ( num -- ) brightness ; +: a ( num -- ) alpha ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VAR: color-stack + +: init-color-stack ( -- ) V{ } clone >color-stack ; + +: push-color ( -- ) self> color-stack> push self> clone >self ; + +: pop-color ( -- ) color-stack> pop dup >self gl-color ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! : double-nth* ( c-array indices -- seq ) swap [ double-nth ] curry map ; + +: double-nth* ( c-array indices -- seq ) + swap byte-array>double-array [ nth ] curry map ; + +: check-size ( modelview -- num ) { 0 1 4 5 } double-nth* [ abs ] map supremum ; + +VAR: threshold + +: iterate? ( -- ? ) get-modelview-matrix check-size threshold> > ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! cos 2a sin 2a 0 0 +! sin 2a -cos 2a 0 0 +! 0 0 1 0 +! 0 0 0 1 + +! column major order + +: gl-flip ( angle -- ) deg>rad dup dup dup + [ 2 * cos , 2 * sin , 0 , 0 , + 2 * sin , 2 * cos neg , 0 , 0 , + 0 , 0 , 1 , 0 , + 0 , 0 , 0 , 1 , ] + double-array{ } make underlying>> glMultMatrixd ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: circle ( -- ) + self> gl-color + gluNewQuadric dup 0 0.5 20 10 gluDisk gluDeleteQuadric ; + +: triangle ( -- ) + self> gl-color + GL_POLYGON glBegin + 0 0.577 glVertex2d + 0.5 -0.289 glVertex2d + -0.5 -0.289 glVertex2d + glEnd ; + +: square ( -- ) + self> gl-color + GL_POLYGON glBegin + -0.5 0.5 glVertex2d + 0.5 0.5 glVertex2d + 0.5 -0.5 glVertex2d + -0.5 -0.5 glVertex2d + glEnd ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: size ( scale -- ) dup 1 glScaled ; + +: size* ( scale-x scale-y -- ) 1 glScaled ; + +: rotate ( angle -- ) 0 0 1 glRotated ; + +: x ( x -- ) 0 0 glTranslated ; + +: y ( y -- ) 0 swap 0 glTranslated ; + +: flip ( angle -- ) gl-flip ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: s ( scale -- ) size ; +: s* ( scale-x scale-y -- ) size* ; +: r ( angle -- ) rotate ; +: f ( angle -- ) flip ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: do ( quot -- ) + push-modelview-matrix + push-color + call + pop-modelview-matrix + pop-color ; inline + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: recursive ( quot -- ) iterate? swap when ; inline + +: multi ( seq -- ) random-weighted* call ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: [rules] ( seq -- quot ) + [ unclip swap [ [ do ] curry ] map concat 2array ] map + [ call-random-weighted ] swap prefix + [ when ] swap prefix + [ iterate? ] swap append ; + +MACRO: rules ( seq -- quot ) [rules] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: [rule] ( seq -- quot ) + [ [ do ] swap prefix ] map concat + [ when ] swap prefix + [ iterate? ] prepend ; + +MACRO: rule ( seq -- quot ) [rule] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +VAR: background + +: set-initial-background ( -- ) T{ hsva f 0 0 1 1 } clone >self ; + +: set-background ( -- ) + set-initial-background + background> call + self> clear-color ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USING: rewrite-closures ; + +VAR: viewport ! { left width bottom height } + +VAR: start-shape + +: set-initial-color ( -- ) T{ hsva f 0 0 0 1 } clone >self ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: dlist + +! : build-model-dlist ( -- ) +! 1 glGenLists dlist set +! dlist get GL_COMPILE_AND_EXECUTE glNewList +! start-shape> call +! glEndList ; + +: build-model-dlist ( -- ) + 1 glGenLists dlist set + dlist get GL_COMPILE_AND_EXECUTE glNewList + + set-initial-color + + self> gl-color + + start-shape> call + + glEndList ; + +: display ( -- ) + + GL_PROJECTION glMatrixMode + glLoadIdentity + viewport> first dup viewport> second + + viewport> third dup viewport> fourth + gluOrtho2D + + GL_MODELVIEW glMatrixMode + glLoadIdentity + + set-background + + GL_COLOR_BUFFER_BIT glClear + + init-modelview-matrix-stack + init-color-stack + + dlist get not + [ build-model-dlist ] + [ dlist get glCallList ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: delete-dlist ( -- ) dlist get [ dlist get 1 glDeleteLists dlist off ] when ; + +: cfdg-window* ( -- slate ) + C[ display ] + { 500 500 } >>pdim + C[ delete-dlist ] >>ungraft + dup "CFDG" open-window ; + +: cfdg-window ( -- slate ) [ cfdg-window* ] with-ui ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: the-slate + +: rebuild ( -- ) delete-dlist the-slate get relayout-1 ; + +: ( -- slate ) + C[ display ] + dup the-slate set + { 500 500 } >>pdim + C[ dlist get [ dlist get 1 glDeleteLists ] when ] >>ungraft + + H{ } clone + T{ key-down f f "ENTER" } C[ drop rebuild ] swap pick set-at + T{ button-down } C[ drop rebuild ] swap pick set-at + >>table ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USE: fry + +: cfdg-window. ( quot -- ) + '[ [ @ "CFDG" open-window ] with-scope ] with-ui ; diff --git a/cfdg/gl/authors.txt b/cfdg/gl/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/cfdg/gl/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/cfdg/gl/gl.factor b/cfdg/gl/gl.factor new file mode 100644 index 0000000..a54f4ca --- /dev/null +++ b/cfdg/gl/gl.factor @@ -0,0 +1,16 @@ + +USING: kernel alien.c-types namespaces sequences opengl.gl ; + +IN: cfdg.gl + +: get-modelview-matrix ( -- alien ) + GL_MODELVIEW_MATRIX 16 "GLdouble" tuck glGetDoublev ; + +SYMBOL: modelview-matrix-stack + +: init-modelview-matrix-stack ( -- ) V{ } clone modelview-matrix-stack set ; + +: push-modelview-matrix ( -- ) + get-modelview-matrix modelview-matrix-stack get push ; + +: pop-modelview-matrix ( -- ) modelview-matrix-stack get pop glLoadMatrixd ; diff --git a/cfdg/models/aqua-star/aqua-star.factor b/cfdg/models/aqua-star/aqua-star.factor new file mode 100644 index 0000000..dbb7eb5 --- /dev/null +++ b/cfdg/models/aqua-star/aqua-star.factor @@ -0,0 +1,36 @@ + +USING: kernel namespaces math random opengl.gl opengl.glu ui ui.gadgets.slate + random-weighted cfdg ; + +IN: cfdg.models.aqua-star + +: tentacle ( -- ) +iterate? [ + { { 1 [ circle + [ .23 y .99 s .002 b tentacle ] do ] } + { 1 [ circle + [ .17 y 2 r .99 s .002 b tentacle ] do ] } + { 1 [ circle + [ .12 y -2 r .99 s .001 b tentacle ] do ] } } + call-random-weighted +] when ; + +: anemone ( -- ) +iterate? [ + tentacle + [ 10 x -11 r .995 s -.002 b anemone ] do +] when ; + +: anemone-begin ( -- ) [ 196 hue 0.8324 sat 1 b anemone ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init ( -- ) + [ -1 b ] >background + { -60 140 -120 140 } >viewport + 0.1 >threshold + [ anemone-begin ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; + +MAIN: run diff --git a/cfdg/models/aqua-star/authors.txt b/cfdg/models/aqua-star/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/cfdg/models/aqua-star/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/cfdg/models/aqua-star/tags.txt b/cfdg/models/aqua-star/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/cfdg/models/aqua-star/tags.txt @@ -0,0 +1 @@ +demos diff --git a/cfdg/models/chiaroscuro/authors.txt b/cfdg/models/chiaroscuro/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/cfdg/models/chiaroscuro/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/cfdg/models/chiaroscuro/chiaroscuro.factor b/cfdg/models/chiaroscuro/chiaroscuro.factor new file mode 100644 index 0000000..d0474cd --- /dev/null +++ b/cfdg/models/chiaroscuro/chiaroscuro.factor @@ -0,0 +1,38 @@ + +USING: kernel namespaces sequences math + opengl.gl opengl.glu ui ui.gadgets.slate + random-weighted cfdg ; + +IN: cfdg.models.chiaroscuro + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +DEFER: white + +: black ( -- ) + { + { 60 [ 0.6 s circle ] [ 0.1 x 5 r 0.99 s -0.01 b -0.01 a black ] } + { 1 [ white black ] } + } + rules ; + +: white ( -- ) + { + { 60 [ 0.6 s circle ] [ 0.1 x -5 r 0.99 s 0.01 b -0.01 a white ] } + { 1 [ black white ] } + } + rules ; + +: chiaroscuro ( -- ) { [ 0.5 b black ] } rule ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init ( -- ) + [ -0.5 b ] >background + { -3 6 -2 6 } >viewport + 0.03 >threshold + [ chiaroscuro ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; + +MAIN: run diff --git a/cfdg/models/chiaroscuro/tags.txt b/cfdg/models/chiaroscuro/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/cfdg/models/chiaroscuro/tags.txt @@ -0,0 +1 @@ +demos diff --git a/cfdg/models/flower6/authors.txt b/cfdg/models/flower6/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/cfdg/models/flower6/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/cfdg/models/flower6/deploy.factor b/cfdg/models/flower6/deploy.factor new file mode 100644 index 0000000..d6dadc0 --- /dev/null +++ b/cfdg/models/flower6/deploy.factor @@ -0,0 +1,12 @@ +USING: tools.deploy.config ; +V{ + { deploy-ui? t } + { deploy-io 1 } + { deploy-reflection 2 } + { deploy-compiler? t } + { deploy-math? t } + { deploy-word-props? f } + { deploy-c-types? f } + { "stop-after-last-window?" t } + { "bundle-name" "cfdg.models.flower6.app" } +} diff --git a/cfdg/models/flower6/flower6.factor b/cfdg/models/flower6/flower6.factor new file mode 100644 index 0000000..91fecd7 --- /dev/null +++ b/cfdg/models/flower6/flower6.factor @@ -0,0 +1,30 @@ + +USING: kernel namespaces sequences math + opengl.gl opengl.glu ui ui.gadgets.slate + random-weighted cfdg ; + +IN: cfdg.models.flower6 + +: petal6 ( -- ) +iterate? [ + [ 1 0.001 s* square ] do + [ -0.5 x 0.01 s -1 b circle ] do + [ 0.5 x 120.21 r 0.996 s 0.5 x 0.005 b petal6 ] do +] when ; + +: flower6 ( -- ) +12 [ [ [ 30 r ] times petal6 ] do ] each +12 [ [ [ 30 r ] times 90 flip petal6 ] do ] each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init ( -- ) + [ ] >background + { -1 2 -1 2 } >viewport + 0.01 >threshold + [ flower6 ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; + +MAIN: run + diff --git a/cfdg/models/flower6/tags.txt b/cfdg/models/flower6/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/cfdg/models/flower6/tags.txt @@ -0,0 +1 @@ +demos diff --git a/cfdg/models/game1-turn6/authors.txt b/cfdg/models/game1-turn6/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/cfdg/models/game1-turn6/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/cfdg/models/game1-turn6/game1-turn6.factor b/cfdg/models/game1-turn6/game1-turn6.factor new file mode 100644 index 0000000..fe48d58 --- /dev/null +++ b/cfdg/models/game1-turn6/game1-turn6.factor @@ -0,0 +1,54 @@ + +USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate + random-weighted cfdg ; + +IN: cfdg.models.game1-turn6 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: f-triangles ( -- ) + { + [ 0.1 x 0.1 y -0.33 alpha 20 hue 0.7 sat 0.80 b triangle ] + [ 10 hue 0.9 sat 0.33 b triangle ] + [ 0.9 s 10 hue 0.5 sat 1.00 b triangle ] + [ 0.8 s 5 r f-triangles ] + } + rule ; + +: f-squares ( -- ) + { + [ 0.1 x 0.1 y -0.33 alpha 250 hue 0.70 sat 0.80 b square ] + [ 220 hue 0.90 sat 0.33 b square ] + [ 0.9 s 220 hue 0.25 sat 1.00 b square ] + [ 0.8 s 5 r f-squares ] + } + rule ; + +DEFER: start + +: spiral ( -- ) + { + { 1 [ f-squares ] + [ 0.5 x 0.5 y 45 r f-triangles ] + [ 1 y 25 r 0.9 s spiral ] } + + { 0.022 [ 90 flip 50 hue start ] } + } + rules ; + +: start ( -- ) + [ spiral ] do + [ 120 r spiral ] do + [ 240 r spiral ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init ( -- ) + [ 66 hue 0.4 sat 0.5 b ] >background + { -5 10 -5 10 } >viewport + 0.001 >threshold + [ start ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; + +MAIN: run diff --git a/cfdg/models/game1-turn6/tags.txt b/cfdg/models/game1-turn6/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/cfdg/models/game1-turn6/tags.txt @@ -0,0 +1 @@ +demos diff --git a/cfdg/models/lesson/authors.txt b/cfdg/models/lesson/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/cfdg/models/lesson/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/cfdg/models/lesson/lesson.factor b/cfdg/models/lesson/lesson.factor new file mode 100644 index 0000000..5902c12 --- /dev/null +++ b/cfdg/models/lesson/lesson.factor @@ -0,0 +1,108 @@ + +USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate + random-weighted cfdg ; + +IN: cfdg.models.lesson + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: shapes ( -- ) +[ square ] do +[ 0.3 b circle ] do +[ 0.5 b triangle ] do +[ 0.7 b 60 r triangle ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: chapter-1 ( -- ) +[ 2 x 5 y 3 size square ] do +[ 6 x 5 y 3 size circle ] do +[ 4 x 2 y 3 size triangle ] do +[ 1 y 3 size shapes ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: foursquare ( -- ) +[ 0 x 0 y 5 3 size* square ] do +[ 0 x 5 y 2 4 size* square ] do +[ 5 x 5 y 3 size square ] do +[ 5 x 0 y 2 size square ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: chapter-2 ( -- ) +[ square ] do +[ 3 x 7 y square ] do +[ 5 x 7 y 30 r square ] do +[ 3 x 5 y 0.75 size square ] do +[ 5 x 5 y 0.5 b square ] do +[ 7 x 6 y 45 r 0.7 size 0.7 b square ] do +[ 5 x 1 y 10 r 0.2 size foursquare ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: spiral ( -- ) +iterate? [ + [ 0.5 size circle ] do + [ 0.2 y -3 r 0.995 size spiral ] do +] when ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: chapter-3 ( -- ) [ 0 x 3 y spiral ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +DEFER: tree + +: branch-left ( -- ) +{ { 1 [ 20 r tree ] } + { 1 [ 30 r tree ] } + { 1 [ 40 r tree ] } + { 1 [ ] } } random-weighted* do ; + +: branch-right ( -- ) +{ { 1 [ -20 r tree ] } + { 1 [ -30 r tree ] } + { 1 [ -40 r tree ] } + { 1 [ ] } } random-weighted* do ; + +: branch ( -- ) branch-left branch-right ; + +: tree ( -- ) +iterate? [ + { + { 20 [ [ 0.25 size circle ] do + [ 0.1 y 0.97 size tree ] do ] } + { 1.5 [ branch ] } + } random-weighted* do +] when ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: chapter-4 ( -- ) +[ 1 x 0 y tree ] do +[ 6 x 0 y tree ] do +[ 1 x 4 y tree ] do +[ 6 x 4 y tree ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: toc ( -- ) +[ 0 x 0 y chapter-1 ] do +[ 10 x 0 y chapter-2 ] do +[ 0 x -10 y chapter-3 ] do +[ 10 x -10 y chapter-4 ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init ( -- ) + [ ] >background + { -5 25 -15 25 } >viewport + 0.03 >threshold + [ toc ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; + +MAIN: run + diff --git a/cfdg/models/lesson/tags.txt b/cfdg/models/lesson/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/cfdg/models/lesson/tags.txt @@ -0,0 +1 @@ +demos diff --git a/cfdg/models/rules08/rules08.factor b/cfdg/models/rules08/rules08.factor new file mode 100644 index 0000000..7b4e88b --- /dev/null +++ b/cfdg/models/rules08/rules08.factor @@ -0,0 +1,48 @@ + +USING: namespaces sequences math random-weighted cfdg ; + +IN: cfdg.models.rules08 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: insct ( -- ) + [ 1.5 5.5 size* -1 brightness triangle ] do + 10 + [ [ [ 1 0.9 size* -0.15 y 0.05 brightness ] times 1 5 size* triangle ] do ] + each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +DEFER: line + +: ligne ( -- ) + { + { 1 [ 4.5 y 1.15 0.8 size* -0.3 b line ] } + { 0.5 [ ] } + } + rules ; + +: line ( -- ) { [ insct ligne ] } rule ; + +: sole ( -- ) + { + { 1 [ 1 brightness 0.5 saturation ligne ] [ 140 r 1 hue sole ] } + { 0.01 [ ] } + } + rules ; + +: centre ( -- ) { [ 1 b 5 s circle ] [ sole ] } rule ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init ( -- ) + [ -1 b ] >background + { -20 40 -20 40 } viewport set + [ centre ] >start-shape + 0.0001 >threshold ; + +: run ( -- ) [ init ] cfdg-window. ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +MAIN: run diff --git a/cfdg/models/rules08/tags.txt b/cfdg/models/rules08/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/cfdg/models/rules08/tags.txt @@ -0,0 +1 @@ +demos diff --git a/cfdg/models/sierpinski/authors.txt b/cfdg/models/sierpinski/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/cfdg/models/sierpinski/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/cfdg/models/sierpinski/sierpinski.factor b/cfdg/models/sierpinski/sierpinski.factor new file mode 100644 index 0000000..c02806f --- /dev/null +++ b/cfdg/models/sierpinski/sierpinski.factor @@ -0,0 +1,37 @@ + +USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate + random-weighted cfdg ; + +IN: cfdg.models.sierpinski + +: shape ( -- ) circle ; + +! : sierpinski ( -- ) +! iterate? [ +! shape +! [ 0.6 s 5 r 0.2 b -1.5 y 0 x sierpinski ] do +! [ 0.6 s 5 r -0.2 b 0.75 y -1.2990375 x sierpinski ] do +! [ 0.6 s 5 r 0.75 y 1.2990375 x sierpinski ] do +! ] when ; + +: sierpinski ( -- ) +iterate? [ + shape + [ -1.5 y 0 x 0.6 s 5 r 0.2 b sierpinski ] do + [ 0.75 y -1.2990375 x 0.6 s 5 r -0.2 b sierpinski ] do + [ 0.75 y 1.2990375 x 0.6 s 5 r sierpinski ] do +] when ; + +: top ( -- ) [ -13.5 r 0.5 b sierpinski ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init ( -- ) + [ ] >background + { -4 8 -4 8 } >viewport + 0.01 >threshold + [ top ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; + +MAIN: run diff --git a/cfdg/models/sierpinski/tags.txt b/cfdg/models/sierpinski/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/cfdg/models/sierpinski/tags.txt @@ -0,0 +1 @@ +demos diff --git a/cfdg/models/snowflake/authors.txt b/cfdg/models/snowflake/authors.txt new file mode 100644 index 0000000..6cfd5da --- /dev/null +++ b/cfdg/models/snowflake/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/cfdg/models/snowflake/snowflake.factor b/cfdg/models/snowflake/snowflake.factor new file mode 100644 index 0000000..9efb335 --- /dev/null +++ b/cfdg/models/snowflake/snowflake.factor @@ -0,0 +1,37 @@ + +USING: kernel namespaces math opengl.gl opengl.glu ui ui.gadgets.slate + random-weighted cfdg ; + +IN: cfdg.models.snowflake + +: spike ( -- ) +iterate? [ + { { 1 [ square + [ 0.95 y 0.97 s spike ] do ] } + { 0.03 [ square + [ 60 r spike ] do + [ -60 r spike ] do + [ 0.95 y 0.97 s spike ] do ] } } + call-random-weighted +] when ; + +: snowflake ( -- ) +spike +[ 60 r spike ] do +[ 120 r spike ] do +[ 180 r spike ] do +[ 240 r spike ] do +[ 300 r spike ] do ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init ( -- ) + [ ] >background + { -40 80 -40 80 } >viewport + 0.1 >threshold + [ snowflake ] >start-shape ; + +: run ( -- ) [ init ] cfdg-window. ; + +MAIN: run + diff --git a/cfdg/models/snowflake/tags.txt b/cfdg/models/snowflake/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/cfdg/models/snowflake/tags.txt @@ -0,0 +1 @@ +demos diff --git a/cfdg/models/spirales/spirales.factor b/cfdg/models/spirales/spirales.factor new file mode 100644 index 0000000..40d58ca --- /dev/null +++ b/cfdg/models/spirales/spirales.factor @@ -0,0 +1,28 @@ + +USING: namespaces sequences math random-weighted cfdg ; + +IN: cfdg.models.spirales + +DEFER: line + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: block ( -- ) { [ circle ] [ 0.3 s 60 flip line ] } rule ; + +: a1 ( -- ) { [ 0.95 s 2 x 12 r 0.5 b 10 hue 1.5 sat a1 ] [ block ] } rule ; + +: line ( -- ) -0.3 a { [ 0 r a1 ] [ 120 r a1 ] [ 240 r a1 ] } rule ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init ( -- ) + [ -1 b ] >background + { -20 40 -20 40 } >viewport + [ line ] >start-shape + 0.04 >threshold ; + +: run ( -- ) [ init ] cfdg-window. ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +MAIN: run diff --git a/cfdg/models/spirales/tags.txt b/cfdg/models/spirales/tags.txt new file mode 100644 index 0000000..cb5fc20 --- /dev/null +++ b/cfdg/models/spirales/tags.txt @@ -0,0 +1 @@ +demos diff --git a/cfdg/summary.txt b/cfdg/summary.txt new file mode 100644 index 0000000..0b5e92c --- /dev/null +++ b/cfdg/summary.txt @@ -0,0 +1 @@ +Implementation of: http://contextfreeart.org diff --git a/closures/closures.factor b/closures/closures.factor new file mode 100644 index 0000000..faa8ec0 --- /dev/null +++ b/closures/closures.factor @@ -0,0 +1,13 @@ +USING: assocs io.pathnames fry namespaces namespaces.private kernel sequences parser hashtables ; +IN: closures +SYMBOL: | + +! Selective Binding +: delayed-bind-with ( vars quot -- quot' ) '[ _ dup [ get ] map zip >hashtable [ _ bind ] curry ] ; +SYNTAX: C[ | parse-until parse-quotation delayed-bind-with append! ; +! Common ones +SYNTAX: DIR[ parse-quotation { current-directory } swap delayed-bind-with append! ; + +! Namespace Binding +: bind-to-namespace ( quot -- quot' ) '[ namespace [ _ bind ] curry ] ; +SYNTAX: NS[ parse-quotation bind-to-namespace append! ; diff --git a/cont-responder/callbacks-tests.factor b/cont-responder/callbacks-tests.factor new file mode 100644 index 0000000..f9302de --- /dev/null +++ b/cont-responder/callbacks-tests.factor @@ -0,0 +1,67 @@ +USING: furnace furnace.actions furnace.callbacks accessors +http http.server http.server.responses tools.test +namespaces io fry sequences +splitting kernel hashtables continuations ; +IN: furnace.callbacks.tests + +[ 123 ] [ + [ + "GET" >>method init-request + [ + exit-continuation set + { } + [ [ "hello" print 123 ] show-final ] >>display + + call-responder + ] callcc1 + ] with-scope +] unit-test + +[ + [ + [ + "hello" print + + ] show-page + "byebye" print + [ 123 ] show-final + ] >>display + "r" set + + [ 123 ] [ + init-request + + [ + exit-continuation set + "GET" >>method init-request + { } "r" get call-responder + ] callcc1 + + body>> first + + + "GET" >>method + dup url>> rot cont-id associate >>query drop + dup url>> "/" >>path drop + init-request + + [ + exit-continuation set + { } + "r" get call-responder + ] callcc1 + + ! get-post-get + + "GET" >>method + dup url>> rot "location" header query>> >>query drop + dup url>> "/" >>path drop + init-request + + [ + exit-continuation set + { } + "r" get call-responder + ] callcc1 + ] unit-test +] with-scope diff --git a/cont-responder/callbacks.factor b/cont-responder/callbacks.factor new file mode 100644 index 0000000..088ae6d --- /dev/null +++ b/cont-responder/callbacks.factor @@ -0,0 +1,122 @@ +! Copyright (C) 2004 Chris Double. +! Copyright (C) 2006, 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: http http.server io kernel math namespaces +continuations calendar sequences assocs hashtables +accessors arrays alarms quotations combinators fry +http.server.redirection furnace assocs.lib urls ; +IN: furnace.callbacks + +SYMBOL: responder + +TUPLE: callback-responder responder callbacks ; + +: ( responder -- responder' ) + H{ } clone callback-responder boa ; + +TUPLE: callback cont quot expires alarm responder ; + +: timeout 20 minutes ; + +: timeout-callback ( callback -- ) + [ alarm>> cancel-alarm ] + [ dup responder>> callbacks>> delete-at ] + bi ; + +: touch-callback ( callback -- ) + dup expires>> [ + dup alarm>> [ cancel-alarm ] when* + dup '[ , timeout-callback ] timeout later >>alarm + ] when drop ; + +: ( cont quot expires? -- callback ) + f callback-responder get callback boa + dup touch-callback ; + +: invoke-callback ( callback -- response ) + [ touch-callback ] + [ quot>> request get exit-continuation get 3array ] + [ cont>> continue-with ] + tri ; + +: register-callback ( cont quot expires? -- id ) + callback-responder get callbacks>> set-at-unique ; + +: forward-to-url ( url -- * ) + ! When executed inside a 'show' call, this will force a + ! HTTP 302 to occur to instruct the browser to forward to + ! the request URL. + exit-with ; + +: cont-id "factorcontid" ; + +: forward-to-id ( id -- * ) + ! When executed inside a 'show' call, this will force a + ! HTTP 302 to occur to instruct the browser to forward to + ! the request URL. + + swap cont-id set-query-param forward-to-url ; + +: restore-request ( pair -- ) + first3 exit-continuation set request set call ; + +SYMBOL: post-refresh-get? + +: redirect-to-here ( -- ) + ! Force a redirect to the client browser so that the browser + ! goes to the current point in the code. This forces an URL + ! change on the browser so that refreshing that URL will + ! immediately run from this code point. This prevents the + ! "this request will issue a POST" warning from the browser + ! and prevents re-running the previous POST logic. This is + ! known as the 'post-refresh-get' pattern. + post-refresh-get? get [ + [ + [ ] t register-callback forward-to-id + ] callcc1 restore-request + ] [ + post-refresh-get? on + ] if ; + +SYMBOL: current-show + +: store-current-show ( -- ) + ! Store the current continuation in the variable 'current-show' + ! so it can be returned to later by 'quot-id'. Note that it + ! recalls itself when the continuation is called to ensure that + ! it resets its value back to the most recent show call. + [ current-show set f ] callcc1 + [ restore-request store-current-show ] when* ; + +: show-final ( quot -- * ) + [ redirect-to-here store-current-show ] dip + call exit-with ; inline + +: resuming-callback ( responder request -- id ) + url>> cont-id query-param swap callbacks>> at ; + +M: callback-responder call-responder* ( path responder -- response ) + '[ + , , + + [ callback-responder set ] + [ request get resuming-callback ] bi + + [ + invoke-callback + ] [ + callback-responder get responder>> call-responder + ] ?if + ] with-exit-continuation ; + +: show-page ( quot -- ) + [ redirect-to-here store-current-show ] dip + [ + [ ] t register-callback swap call exit-with + ] callcc1 restore-request ; inline + +: quot-id ( quot -- id ) + current-show get swap t register-callback ; + +: quot-url ( quot -- url ) + quot-id f swap cont-id associate derive-url ; diff --git a/cryptlib/authors.txt b/cryptlib/authors.txt new file mode 100644 index 0000000..7c29e7c --- /dev/null +++ b/cryptlib/authors.txt @@ -0,0 +1 @@ +Elie Chaftari diff --git a/cryptlib/cryptlib-tests.factor b/cryptlib/cryptlib-tests.factor new file mode 100644 index 0000000..aeac468 --- /dev/null +++ b/cryptlib/cryptlib-tests.factor @@ -0,0 +1,377 @@ +USING: cryptlib.libcl cryptlib prettyprint kernel alien sequences libc math +tools.test io io.files continuations alien.c-types splitting generic.math +io.encodings.binary ; + +"=========================================================" print +"Envelope/de-envelop test..." print +"=========================================================" print + +[ + ! envelope + CRYPT_FORMAT_CRYPTLIB [ + "Hello world" set-pop-buffer + envelope-handle CRYPT_ENVINFO_DATASIZE + get-pop-buffer alien>char-string length set-attribute + envelope-handle get-pop-buffer dup alien>char-string length push-data + get-bytes-copied . + envelope-handle flush-data + envelope-handle 1024 pop-data + get-bytes-copied . + pop-buffer-string . + ] with-envelope + + ! de-envelope + CRYPT_FORMAT_AUTO [ + envelope-handle get-pop-buffer get-bytes-copied push-data + get-bytes-copied . + envelope-handle flush-data + envelope-handle get-bytes-copied pop-data + get-bytes-copied . + [ "Hello world" ] [ pop-buffer-string ] unit-test + ] with-envelope + +] with-cryptlib + +"=========================================================" print +"Password encryption test..." print +"=========================================================" print + +[ + ! envelope + CRYPT_FORMAT_CRYPTLIB [ + envelope-handle CRYPT_ENVINFO_PASSWORD "password" set-attribute-string + "Hello world" set-pop-buffer + envelope-handle CRYPT_ENVINFO_DATASIZE + get-pop-buffer alien>char-string length set-attribute + envelope-handle get-pop-buffer dup alien>char-string length push-data + get-bytes-copied . + envelope-handle flush-data + envelope-handle 1024 pop-data + get-bytes-copied . + pop-buffer-string . + ] with-envelope + + ! de-envelope + CRYPT_FORMAT_AUTO [ + [ envelope-handle get-pop-buffer get-bytes-copied push-data ] [ + dup CRYPT_ENVELOPE_RESOURCE = [ + envelope-handle CRYPT_ENVINFO_PASSWORD + "password" set-attribute-string + ] [ + rethrow + ] if + ] recover drop + get-bytes-copied . + envelope-handle flush-data + envelope-handle get-bytes-copied pop-data + get-bytes-copied . + [ "Hello world" ] [ pop-buffer-string ] unit-test + ] with-envelope +] with-cryptlib + +"=========================================================" print +"Compression test..." print +"=========================================================" print + +[ + ! envelope + CRYPT_FORMAT_CRYPTLIB [ + envelope-handle CRYPT_ENVINFO_COMPRESSION CRYPT_UNUSED set-attribute + "Hello world" set-pop-buffer + envelope-handle CRYPT_ENVINFO_DATASIZE + get-pop-buffer alien>char-string length set-attribute + envelope-handle get-pop-buffer dup alien>char-string length push-data + get-bytes-copied . + envelope-handle flush-data + envelope-handle 1024 pop-data + get-bytes-copied . + pop-buffer-string . + ] with-envelope + + ! de-envelope + CRYPT_FORMAT_AUTO [ + envelope-handle get-pop-buffer get-bytes-copied push-data + get-bytes-copied . + envelope-handle flush-data + envelope-handle get-bytes-copied pop-data + get-bytes-copied . + [ "Hello world" ] [ pop-buffer-string ] unit-test + ] with-envelope +] with-cryptlib + +"=========================================================" print +"Conventional encryption test..." print +"=========================================================" print + +[ + ! envelope + CRYPT_FORMAT_CRYPTLIB [ + CRYPT_ALGO_IDEA [ + context-handle CRYPT_CTXINFO_KEY "0123456789ABCDEF" set-attribute-string + envelope-handle CRYPT_ENVINFO_SESSIONKEY context-handle *int set-attribute + ] with-context + + "Hello world" set-pop-buffer + envelope-handle CRYPT_ENVINFO_DATASIZE + get-pop-buffer alien>char-string length set-attribute + envelope-handle get-pop-buffer dup alien>char-string length push-data + get-bytes-copied . + envelope-handle flush-data + envelope-handle 1024 pop-data + get-bytes-copied . + pop-buffer-string . + ] with-envelope + + ! de-envelope + CRYPT_FORMAT_AUTO [ + [ envelope-handle get-pop-buffer get-bytes-copied push-data ] [ + dup CRYPT_ENVELOPE_RESOURCE = [ + CRYPT_ALGO_IDEA create-context + context-handle CRYPT_CTXINFO_KEY "0123456789ABCDEF" + set-attribute-string + envelope-handle CRYPT_ENVINFO_SESSIONKEY context-handle *int + set-attribute + ] [ + rethrow + ] if + ] recover drop + + get-bytes-copied . + destroy-context + envelope-handle flush-data + envelope-handle get-bytes-copied pop-data + get-bytes-copied . + [ "Hello world" ] [ pop-buffer-string ] unit-test + ] with-envelope +] with-cryptlib + +"=========================================================" print +"Large data size envelope/de-envelop test..." print +"=========================================================" print + +[ + ! envelope + CRYPT_FORMAT_CRYPTLIB [ + "extra/cryptlib/test/large_data.txt" resource-path + binary file-contents set-pop-buffer + envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE + get-pop-buffer alien>char-string length 10000 + set-attribute + envelope-handle CRYPT_ENVINFO_DATASIZE + get-pop-buffer alien>char-string length set-attribute + envelope-handle get-pop-buffer dup alien>char-string length push-data + get-bytes-copied . + envelope-handle flush-data + envelope-handle get-pop-buffer alien>char-string length 10000 + pop-data + get-bytes-copied . + ! pop-buffer-string . + ] with-envelope + + ! de-envelope + CRYPT_FORMAT_AUTO [ + envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE + get-pop-buffer alien>char-string length 10000 + set-attribute + envelope-handle get-pop-buffer get-bytes-copied push-data + get-bytes-copied . + envelope-handle flush-data + envelope-handle get-bytes-copied pop-data + get-bytes-copied . + ! pop-buffer-string . + [ "/opt/local/lib/libcl.dylib(dylib1.o):" ] + [ pop-buffer-string "\n" split first ] unit-test + [ "00000000 t __mh_dylib_header" ] + [ pop-buffer-string "\n" split last/first first ] unit-test + ] with-envelope +] with-cryptlib + +"=========================================================" print +"Large data size password encryption test..." print +"=========================================================" print + +[ + + ! envelope + CRYPT_FORMAT_CRYPTLIB [ + envelope-handle CRYPT_ENVINFO_PASSWORD "password" set-attribute-string + "extra/cryptlib/test/large_data.txt" resource-path + binary file-contents set-pop-buffer + envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE + get-pop-buffer alien>char-string length 10000 + set-attribute + envelope-handle CRYPT_ENVINFO_DATASIZE + get-pop-buffer alien>char-string length set-attribute + envelope-handle get-pop-buffer dup alien>char-string length push-data + get-bytes-copied . + envelope-handle flush-data + envelope-handle get-pop-buffer alien>char-string length 10000 + pop-data + get-bytes-copied . + pop-buffer-string . + ] with-envelope + + ! de-envelope + CRYPT_FORMAT_AUTO [ + envelope-handle CRYPT_ATTRIBUTE_BUFFERSIZE 130000 set-attribute + [ envelope-handle get-pop-buffer get-bytes-copied push-data ] [ + dup CRYPT_ENVELOPE_RESOURCE = [ + envelope-handle CRYPT_ENVINFO_PASSWORD + "password" set-attribute-string + ] [ + rethrow + ] if + ] recover drop + + get-bytes-copied . + envelope-handle flush-data + envelope-handle get-bytes-copied pop-data + get-bytes-copied . + ! pop-buffer-string . + + [ "/opt/local/lib/libcl.dylib(dylib1.o):" ] + [ pop-buffer-string "\n" split first ] unit-test + + [ "00000000 t __mh_dylib_header" ] + [ pop-buffer-string "\n" split last/first first ] unit-test + ] with-envelope +] with-cryptlib + +"=========================================================" print +"Generating a key pair test..." print +"=========================================================" print + +[ + CRYPT_ALGO_RSA [ + context-handle CRYPT_CTXINFO_LABEL "private key" set-attribute-string + + ! a particular key length can be set (e.g. 1536-bit/192-byte key) + context-handle CRYPT_CTXINFO_KEYSIZE 1536 8 / set-attribute + + context-handle generate-key + + CRYPT_KEYSET_FILE "extra/cryptlib/test/keys.p15" resource-path + CRYPT_KEYOPT_CREATE [ + "password" add-private-key + ] with-keyset + ] with-context +] with-cryptlib + +"Passed" print + +"=========================================================" print +"Simple certificate creation test..." print +"=========================================================" print + +[ + CRYPT_ALGO_RSA [ + context-handle CRYPT_CTXINFO_LABEL "private key" set-attribute-string + context-handle generate-key + CRYPT_KEYSET_FILE "extra/cryptlib/test/keys.p15" resource-path + CRYPT_KEYOPT_CREATE [ + "password" add-private-key + CRYPT_CERTTYPE_CERTIFICATE [ + certificate-handle CRYPT_CERTINFO_XYZZY 1 set-attribute + certificate-handle CRYPT_CERTINFO_SUBJECTPUBLICKEYINFO + context-handle *int set-attribute + certificate-handle CRYPT_CERTINFO_COMMONNAME "Dave Smith" + set-attribute-string + sign-certificate + check-certificate + add-public-key + f 0 CRYPT_CERTFORMAT_TEXT_CERTIFICATE export-certificate + get-cert-length *int dup malloc swap + CRYPT_CERTFORMAT_TEXT_CERTIFICATE export-certificate + get-cert-buffer alien>char-string print + ] with-certificate + ] with-keyset + ] with-context +] with-cryptlib + +: ssh-session ( -- ) + "=========================================================" print + "SSH session test..." print + "=========================================================" print + + ! start client connection with: + ! ssh -v localhost -p3000 + "waiting for: ssh -v localhost -p3000" print flush + + ! Are you sure you want to continue connecting (yes/no)? yes + ! ... + ! localhost's password: (any password will be accepted) + + ! If you want to run the test again you should clean the [localhost]:3000 + ! ssh-rsa entry in the known_hosts file, in your home directory under the .ssh + ! folder, since the test generates a new RSA certificate on every run. + + [ + CRYPT_KEYSET_FILE "extra/cryptlib/test/keys.p15" resource-path + CRYPT_KEYOPT_READONLY [ + CRYPT_KEYID_NAME "private key" "password" get-private-key + + CRYPT_SESSION_SSH_SERVER [ + + session-handle CRYPT_SESSINFO_SERVER_NAME "localhost" + set-attribute-string + + session-handle CRYPT_SESSINFO_SERVER_PORT 3000 set-attribute + + session-handle CRYPT_SESSINFO_PRIVATEKEY + + context-handle *int set-attribute + + [ session-handle CRYPT_SESSINFO_ACTIVE 1 set-attribute ] [ + dup CRYPT_ENVELOPE_RESOURCE = [ + session-handle CRYPT_SESSINFO_AUTHRESPONSE 1 + set-attribute + + session-handle CRYPT_SESSINFO_ACTIVE 1 set-attribute + + "Welcome to cryptlib, now go away.\r\n" set-pop-buffer + + session-handle get-pop-buffer dup alien>char-string + length push-data + + session-handle flush-data + ] [ + rethrow + ] if + ] recover drop + ] with-session + ] with-keyset + ] with-cryptlib + + "Passed" print +; + +: ssl-session ( -- ) + "=========================================================" print + "SSL session test..." print + "=========================================================" print + + ! start client connection with: + ! curl -k https://localhost:3000 + "waiting for: curl -k https://localhost:3000" print flush + + [ + CRYPT_KEYSET_FILE "extra/cryptlib/test/keys.p15" resource-path + CRYPT_KEYOPT_READONLY [ + CRYPT_KEYID_NAME "private key" "password" get-private-key + + CRYPT_SESSION_SSL_SERVER [ + session-handle CRYPT_SESSINFO_SERVER_NAME "localhost" + set-attribute-string + session-handle CRYPT_SESSINFO_SERVER_PORT 3000 set-attribute + session-handle CRYPT_OPTION_NET_WRITETIMEOUT 10 set-attribute + session-handle CRYPT_OPTION_NET_READTIMEOUT 10 set-attribute + session-handle CRYPT_OPTION_NET_CONNECTTIMEOUT 10 set-attribute + session-handle CRYPT_SESSINFO_PRIVATEKEY + context-handle *int set-attribute + + session-handle CRYPT_SESSINFO_ACTIVE 1 set-attribute + "Welcome to cryptlib, now go away.\r\n" set-pop-buffer + session-handle get-pop-buffer dup alien>char-string + length push-data + session-handle flush-data + ] with-session + ] with-keyset + ] with-cryptlib + + "Passed" print +; diff --git a/cryptlib/cryptlib.factor b/cryptlib/cryptlib.factor new file mode 100644 index 0000000..1bb9f3d --- /dev/null +++ b/cryptlib/cryptlib.factor @@ -0,0 +1,234 @@ +! Copyright (C) 2007 Elie CHAFTARI +! See http://factorcode.org/license.txt for BSD license. + +! libs/cryptib/cryptlib.factor + +! Adapted from cryptlib.h +! Tested with cryptlib 3.3.1.0 +USING: cryptlib.libcl kernel hashtables alien math +namespaces sequences assocs libc alien.c-types alien.accessors continuations ; + +IN: cryptlib + +SYMBOL: keyset +SYMBOL: certificate +SYMBOL: cert-buffer +SYMBOL: cert-length +SYMBOL: context +SYMBOL: envelope +SYMBOL: bytes-copied +SYMBOL: pop-buffer +SYMBOL: session + +! ========================================================= +! Error-handling routines +! ========================================================= + +: check-result ( result -- ) + dup CRYPT_OK = [ + drop + ] [ + dup CRYPT_ENVELOPE_RESOURCE = [ + throw + ] [ + dup error-messages >hashtable at throw + ] if + ] if ; + +! ========================================================= +! Secure pointer-freeing routines +! ========================================================= + +: secure-free ( ptr n -- ) + [ dupd 0 -rot set-alien-unsigned-1 ] each free ; + +: secure-free-array ( ptr n type -- ) + heap-size * [ dupd 0 -rot set-alien-unsigned-1 ] each free ; + +: secure-free-object ( ptr type -- ) + 1 swap secure-free-array ; + +! ========================================================= +! Initialise and shut down cryptlib +! ========================================================= + +: init ( -- ) + cryptInit check-result ; + +: end ( -- ) + cryptEnd check-result ; + +: with-cryptlib ( quot -- ) + [ init [ end ] [ ] cleanup ] with-scope ; inline + +! ========================================================= +! Create and destroy an encryption context +! ========================================================= + +: create-context ( algo -- ) + >r "int" dup swap CRYPT_UNUSED r> cryptCreateContext + check-result context set ; + +: destroy-context ( -- ) + context get [ *int cryptDestroyContext check-result ] when* + context off ; + +: with-context ( algo quot -- ) + swap create-context [ destroy-context ] [ ] cleanup ; inline + +! ========================================================= +! Keyset routines +! ========================================================= + +: open-keyset ( type name options -- ) + >r >r >r "int" dup swap CRYPT_UNUSED r> r> string>char-alien + r> cryptKeysetOpen check-result keyset set ; + +: close-keyset ( -- ) + keyset get *int cryptKeysetClose check-result + destroy-context ; + +: with-keyset ( type name options quot -- ) + >r open-keyset r> [ close-keyset ] [ ] cleanup ; inline + +: get-public-key ( idtype id -- ) + >r >r keyset get *int "int*" tuck r> r> string>char-alien + cryptGetPublicKey check-result context set ; + +: get-private-key ( idtype id password -- ) + >r >r >r keyset get *int "int*" tuck r> + r> string>char-alien r> string>char-alien cryptGetPrivateKey + check-result context set ; + +: get-key ( idtype id password -- ) + >r >r >r keyset get *int "int*" tuck r> + r> string>char-alien r> string>char-alien cryptGetKey + check-result context set ; + +: add-public-key ( -- ) + keyset get *int certificate get *int cryptAddPublicKey check-result ; + +: add-private-key ( password -- ) + >r keyset get *int context get *int r> string>char-alien + cryptAddPrivateKey check-result ; + +: delete-key ( type id -- ) + >r >r keyset get *int r> r> string>char-alien cryptDeleteKey + check-result ; + +! ========================================================= +! Certificate routines +! ========================================================= + +: create-certificate ( type -- ) + >r "int" dup swap CRYPT_UNUSED r> + cryptCreateCert check-result certificate set ; + +: destroy-certificate ( -- ) + certificate get *int cryptDestroyCert check-result ; + +: with-certificate ( type quot -- ) + swap create-certificate [ destroy-certificate ] [ ] cleanup ; inline + +: sign-certificate ( -- ) + certificate get *int context get *int cryptSignCert check-result ; + +: check-certificate ( -- ) + certificate get *int context get *int cryptCheckCert check-result ; + +: import-certificate ( certbuffer length -- ) + >r r> CRYPT_UNUSED "int*" malloc-object dup >r + cryptImportCert check-result r> certificate set ; + +: export-certificate ( certbuffer maxlength format -- ) + >r >r dup swap r> "int*" malloc-object dup r> swap >r + certificate get *int cryptExportCert check-result + cert-buffer set r> cert-length set ; + +! ========================================================= +! Generate a key into a context +! ========================================================= + +: generate-key ( handle -- ) + *int cryptGenerateKey check-result ; + +! ========================================================= +! Get/set/delete attribute functions +! ========================================================= + +: set-attribute ( handle attribute value -- ) + >r >r *int r> r> cryptSetAttribute check-result ; + +: set-attribute-string ( handle attribute value -- ) + >r >r *int r> r> dup length swap string>char-alien swap + cryptSetAttributeString check-result ; + +! ========================================================= +! Envelope and Session routines +! ========================================================= + +: create-envelope ( format -- ) + >r "int" dup swap CRYPT_UNUSED r> cryptCreateEnvelope + check-result envelope set ; + +: destroy-envelope ( -- ) + envelope get *int cryptDestroyEnvelope check-result ; + +: with-envelope ( format quot -- ) + swap create-envelope [ destroy-envelope ] [ ] cleanup ; + +: create-session ( format -- ) + >r "int" dup swap CRYPT_UNUSED r> cryptCreateSession + check-result session set ; + +: destroy-session ( -- ) + session get *int cryptDestroySession check-result ; + +: with-session ( format quot -- ) + swap create-session [ destroy-session ] [ ] cleanup ; + +: push-data ( handle buffer length -- ) + >r >r *int r> r> "int" [ cryptPushData ] + keep swap check-result bytes-copied set ; + +: flush-data ( handle -- ) + *int cryptFlushData check-result ; + +: pop-data ( handle length -- ) + dup >r >r *int r> "uchar*" malloc-array + dup r> swap >r "int" [ cryptPopData ] keep + swap check-result bytes-copied set r> pop-buffer set ; + +! ========================================================= +! Public routines +! ========================================================= + +: envelope-handle ( -- envelope ) + envelope get ; + +: context-handle ( -- context ) + context get ; + +: certificate-handle ( -- certificate ) + certificate get ; + +: session-handle ( -- session ) + session get ; + +: set-pop-buffer ( data -- ) + string>char-alien pop-buffer set ; + +: get-pop-buffer ( -- buffer ) + pop-buffer get ; + +: pop-buffer-string ( -- s ) + pop-buffer get alien>char-string ; + +: get-bytes-copied ( -- value ) + bytes-copied get *int ; + +: get-cert-buffer ( -- certreq ) + cert-buffer get ; + +: get-cert-length ( -- certlength ) + cert-length get ; diff --git a/cryptlib/libcl/libcl.factor b/cryptlib/libcl/libcl.factor new file mode 100644 index 0000000..634d766 --- /dev/null +++ b/cryptlib/libcl/libcl.factor @@ -0,0 +1,1052 @@ +! Copyright (C) 2007 Elie CHAFTARI +! See http://factorcode.org/license.txt for BSD license. + +! libs/cryptlib/libcl.factor + +! Adapted from cryptlib.h +! Tested with cryptlib 3.3.1.0 + +! export LD_LIBRARY_PATH=/opt/local/lib + +USING: alien kernel system combinators alien.syntax ; + +IN: cryptlib.libcl + +<< "libcl" { + { [ win32? ] [ "cl32.dll" stdcall ] } + { [ macosx? ] [ "libcl.dylib" cdecl ] } + { [ unix? ] [ "libcl.so" cdecl ] } + } cond add-library >> + +! =============================================== +! Machine-dependant types +! =============================================== + +TYPEDEF: int C_RET + +! =============================================== +! Algorithm and Object Types +! =============================================== + +! Algorithm and mode types + +! CRYPT_ALGO_TYPE +: CRYPT_ALGO_NONE 0 ; inline ! No encryption +: CRYPT_ALGO_DES 1 ; inline ! DES +: CRYPT_ALGO_3DES 2 ; inline ! Triple DES +: CRYPT_ALGO_IDEA 3 ; inline ! IDEA +: CRYPT_ALGO_CAST 4 ; inline ! CAST-128 +: CRYPT_ALGO_RC2 5 ; inline ! RC2 +: CRYPT_ALGO_RC4 6 ; inline ! RC4 +: CRYPT_ALGO_RC5 7 ; inline ! RC5 +: CRYPT_ALGO_AES 8 ; inline ! AES +: CRYPT_ALGO_BLOWFISH 9 ; inline ! Blowfish +: CRYPT_ALGO_SKIPJACK 10 ; inline ! Skipjack +: CRYPT_ALGO_DH 100 ; inline ! Diffie-Hellman +: CRYPT_ALGO_RSA 101 ; inline ! RSA +: CRYPT_ALGO_DSA 102 ; inline ! DSA +: CRYPT_ALGO_ELGAMAL 103 ; inline ! ElGamal +: CRYPT_ALGO_KEA 104 ; inline ! KEA +: CRYPT_ALGO_ECDSA 105 ; inline ! ECDSA +: CRYPT_ALGO_MD2 200 ; inline ! MD2 +: CRYPT_ALGO_MD4 201 ; inline ! MD4 +: CRYPT_ALGO_MD5 202 ; inline ! MD5 +: CRYPT_ALGO_SHA 203 ; inline ! SHA/SHA1 +: CRYPT_ALGO_RIPEMD160 204 ; inline ! RIPE-MD 160 +: CRYPT_ALGO_SHA2 205 ; inline ! SHA2 (SHA-256/384/512) +: CRYPT_ALGO_HMAC_MD5 300 ; inline ! HMAC-MD5 +: CRYPT_ALGO_HMAC_SHA1 301 ; inline ! HMAC-SHA +: CRYPT_ALGO_HMAC_SHA 301 ; inline ! Older form +: CRYPT_ALGO_HMAC_RIPEMD160 302 ; inline ! HMAC-RIPEMD-160 +: CRYPT_ALGO_LAST 303 ; inline ! Last possible crypt algo value +: CRYPT_ALGO_FIRST_CONVENTIONAL 1 ; inline +: CRYPT_ALGO_LAST_CONVENTIONAL 99 ; inline +: CRYPT_ALGO_FIRST_PKC 100 ; inline +: CRYPT_ALGO_LAST_PKC 199 ; inline +: CRYPT_ALGO_FIRST_HASH 200 ; inline +: CRYPT_ALGO_LAST_HASH 299 ; inline +: CRYPT_ALGO_FIRST_MAC 300 ; inline +: CRYPT_ALGO_LAST_MAC 399 ; inline ! End of mac algo.range + +TYPEDEF: int CRYPT_ALGO_TYPE + +! CRYPT_MODE_TYPE +: CRYPT_MODE_NONE 0 ; inline ! No encryption mode +: CRYPT_MODE_ECB 1 ; inline ! ECB +: CRYPT_MODE_CBC 2 ; inline ! CBC +: CRYPT_MODE_CFB 3 ; inline ! CFB +: CRYPT_MODE_OFB 4 ; inline ! OFB +: CRYPT_MODE_LAST 5 ; inline ! Last possible crypt mode value + + +! Keyset subtypes + +! CRYPT_KEYSET_TYPE +: CRYPT_KEYSET_NONE 0 ; inline ! No keyset type +: CRYPT_KEYSET_FILE 1 ; inline ! Generic flat file keyset +: CRYPT_KEYSET_HTTP 2 ; inline ! Web page containing cert/CRL +: CRYPT_KEYSET_LDAP 3 ; inline ! LDAP directory service +: CRYPT_KEYSET_ODBC 4 ; inline ! Generic ODBC interface +: CRYPT_KEYSET_DATABASE 5 ; inline ! Generic RDBMS interface +: CRYPT_KEYSET_PLUGIN 6 ; inline ! Generic database plugin +: CRYPT_KEYSET_ODBC_STORE 7 ; inline ! ODBC certificate store +: CRYPT_KEYSET_DATABASE_STORE 8 ; inline ! Database certificate store +: CRYPT_KEYSET_PLUGIN_STORE 9 ; inline ! Database plugin certificate store +: CRYPT_KEYSET_LAST 10 ; inline ! Last possible keyset type + +TYPEDEF: int CRYPT_KEYSET_TYPE + +! Device subtypes + +! CRYPT_DEVICE_TYPE +: CRYPT_DEVICE_NONE 0 ; inline ! No crypto device +: CRYPT_DEVICE_FORTEZZA 1 ; inline ! Fortezza card +: CRYPT_DEVICE_PKCS11 2 ; inline ! PKCS #11 crypto token +: CRYPT_DEVICE_CRYPTOAPI 3 ; inline ! Microsoft CryptoAPI +: CRYPT_DEVICE_LAST 4 ; inline ! Last possible crypto device type + +! Certificate subtypes + +! CRYPT_CERTTYPE_TYPE +: CRYPT_CERTTYPE_NONE 0 ; inline ! No certificate type +: CRYPT_CERTTYPE_CERTIFICATE 1 ; inline ! Certificate +: CRYPT_CERTTYPE_ATTRIBUTE_CERT 2 ; inline ! Attribute certificate +: CRYPT_CERTTYPE_CERTCHAIN 3 ; inline ! PKCS #7 certificate chain +: CRYPT_CERTTYPE_CERTREQUEST 4 ; inline ! PKCS #10 certification request +: CRYPT_CERTTYPE_REQUEST_CERT 5 ; inline ! CRMF certification request +: CRYPT_CERTTYPE_REQUEST_REVOCATION 6 ; inline ! CRMF revocation request +: CRYPT_CERTTYPE_CRL 7 ; inline ! CRL +: CRYPT_CERTTYPE_CMS_ATTRIBUTES 8 ; inline ! CMS attributes +: CRYPT_CERTTYPE_RTCS_REQUEST 9 ; inline ! RTCS request +: CRYPT_CERTTYPE_RTCS_RESPONSE 10 ; inline ! RTCS response +: CRYPT_CERTTYPE_OCSP_REQUEST 11 ; inline ! OCSP request +: CRYPT_CERTTYPE_OCSP_RESPONSE 12 ; inline ! OCSP response +: CRYPT_CERTTYPE_PKIUSER 13 ; inline ! PKI user information +: CRYPT_CERTTYPE_LAST 14 ; inline ! Last possible cert.type + +TYPEDEF: int CRYPT_CERTTYPE_TYPE + +! Envelope/data format subtypes + +! CRYPT_FORMAT_TYPE +: CRYPT_FORMAT_NONE 0 ; inline ! No format type +: CRYPT_FORMAT_AUTO 1 ; inline ! Deenv, auto-determine type +: CRYPT_FORMAT_CRYPTLIB 2 ; inline ! cryptlib native format +: CRYPT_FORMAT_CMS 3 ; inline ! PKCS #7 / CMS / S/MIME fmt. +: CRYPT_FORMAT_PKCS7 3 ; inline +: CRYPT_FORMAT_SMIME 4 ; inline ! As CMS with MSG-style behaviour +: CRYPT_FORMAT_PGP 5 ; inline ! PGP format +: CRYPT_FORMAT_LAST 6 ; inline ! Last possible format type + +TYPEDEF: int CRYPT_FORMAT_TYPE + +! Session subtypes + +! CRYPT_SESSION_TYPE +: CRYPT_SESSION_NONE 0 ; inline ! No session type +: CRYPT_SESSION_SSH 1 ; inline ! SSH +: CRYPT_SESSION_SSH_SERVER 2 ; inline ! SSH server +: CRYPT_SESSION_SSL 3 ; inline ! SSL/TLS +: CRYPT_SESSION_SSL_SERVER 4 ; inline ! SSL/TLS server +: CRYPT_SESSION_RTCS 5 ; inline ! RTCS +: CRYPT_SESSION_RTCS_SERVER 6 ; inline ! RTCS server +: CRYPT_SESSION_OCSP 7 ; inline ! OCSP +: CRYPT_SESSION_OCSP_SERVER 8 ; inline ! OCSP server +: CRYPT_SESSION_TSP 9 ; inline ! TSP +: CRYPT_SESSION_TSP_SERVER 10 ; inline ! TSP server +: CRYPT_SESSION_CMP 11 ; inline ! CMP +: CRYPT_SESSION_CMP_SERVER 12 ; inline ! CMP server +: CRYPT_SESSION_SCEP 13 ; inline ! SCEP +: CRYPT_SESSION_SCEP_SERVER 14 ; inline ! SCEP server +: CRYPT_SESSION_CERTSTORE_SERVER 15 ; inline ! HTTP cert store interface +: CRYPT_SESSION_LAST 16 ; inline ! Last possible session type + +TYPEDEF: int CRYPT_SESSION_TYPE + +! User subtypes + +! CRYPT_USER_TYPE +: CRYPT_USER_NONE 0 ; inline ! No user type +: CRYPT_USER_NORMAL 1 ; inline ! Normal user +: CRYPT_USER_SO 2 ; inline ! Security officer +: CRYPT_USER_CA 3 ; inline ! CA user +: CRYPT_USER_LAST 4 ; inline ! Last possible user type + +! =============================================== +! Attribute Types +! =============================================== + +! Attribute types. These are arranged in the following order: +! +! PROPERTY - Object property +! ATTRIBUTE - Generic attributes +! OPTION - Global or object-specific config.option +! CTXINFO - Context-specific attribute +! CERTINFO - Certificate-specific attribute +! KEYINFO - Keyset-specific attribute +! DEVINFO - Device-specific attribute +! ENVINFO - Envelope-specific attribute +! SESSINFO - Session-specific attribute +! USERINFO - User-specific attribute + +! CRYPT_ATTRIBUTE_TYPE +: CRYPT_ATTRIBUTE_NONE 0 ; inline ! Non-value +: CRYPT_PROPERTY_FIRST 1 ; inline ! ******************* +: CRYPT_PROPERTY_HIGHSECURITY 2 ; inline ! Owned+non-forwardcount+locked +: CRYPT_PROPERTY_OWNER 3 ; inline ! Object owner +: CRYPT_PROPERTY_FORWARDCOUNT 4 ; inline ! No.of times object can be forwarded +: CRYPT_PROPERTY_LOCKED 5 ; inline ! Whether properties can be chged/read +: CRYPT_PROPERTY_USAGECOUNT 6 ; inline ! Usage count before object expires +: CRYPT_PROPERTY_NONEXPORTABLE 7 ; inline ! Whether key is nonexp.from context +: CRYPT_PROPERTY_LAST 8 ; inline +: CRYPT_GENERIC_FIRST 9 ; inline ! Extended error information +: CRYPT_ATTRIBUTE_ERRORTYPE 10 ; inline ! Type of last error +: CRYPT_ATTRIBUTE_ERRORLOCUS 11 ; inline ! Locus of last error +: CRYPT_ATTRIBUTE_INT_ERRORCODE 12 ; inline ! Low-level software-specific +: CRYPT_ATTRIBUTE_INT_ERRORMESSAGE 13 ; inline ! error code and message +: CRYPT_ATTRIBUTE_CURRENT_GROUP 14 ; inline ! Cursor mgt: Group in attribute list +: CRYPT_ATTRIBUTE_CURRENT 15 ; inline ! Cursor mgt: Entry in attribute list +: CRYPT_ATTRIBUTE_CURRENT_INSTANCE 16 ; inline ! Cursor mgt: Instance in attribute list +: CRYPT_ATTRIBUTE_BUFFERSIZE 17 ; inline ! Internal data buffer size +: CRYPT_GENERIC_LAST 18 ; inline +: CRYPT_OPTION_FIRST 100 ; inline ! ************************** +: CRYPT_OPTION_INFO_DESCRIPTION 101 ; inline ! Text description +: CRYPT_OPTION_INFO_COPYRIGHT 102 ; inline ! Copyright notice +: CRYPT_OPTION_INFO_MAJORVERSION 103 ; inline ! Major release version +: CRYPT_OPTION_INFO_MINORVERSION 104 ; inline ! Minor release version +: CRYPT_OPTION_INFO_STEPPING 105 ; inline ! Release stepping +: CRYPT_OPTION_ENCR_ALGO 106 ; inline ! Encryption algorithm +: CRYPT_OPTION_ENCR_HASH 107 ; inline ! Hash algorithm +: CRYPT_OPTION_ENCR_MAC 108 ; inline ! MAC algorithm +: CRYPT_OPTION_PKC_ALGO 109 ; inline ! Public-key encryption algorithm +: CRYPT_OPTION_PKC_KEYSIZE 110 ; inline ! Public-key encryption key size +: CRYPT_OPTION_SIG_ALGO 111 ; inline ! Signature algorithm +: CRYPT_OPTION_SIG_KEYSIZE 112 ; inline ! Signature keysize +: CRYPT_OPTION_KEYING_ALGO 113 ; inline ! Key processing algorithm +: CRYPT_OPTION_KEYING_ITERATIONS 114 ; inline ! Key processing iterations +: CRYPT_OPTION_CERT_SIGNUNRECOGNISEDATTRIBUTES 115 ; inline ! Whether to sign unrecog.attrs +: CRYPT_OPTION_CERT_VALIDITY 116 ; inline ! Certificate validity period +: CRYPT_OPTION_CERT_UPDATEINTERVAL 117 ; inline ! CRL update interval +: CRYPT_OPTION_CERT_COMPLIANCELEVEL 118 ; inline ! PKIX compliance level for cert chks. +: CRYPT_OPTION_CERT_REQUIREPOLICY 119 ; inline ! Whether explicit policy req'd for certs +: CRYPT_OPTION_CMS_DEFAULTATTRIBUTES 120 ; inline ! Add default CMS attributes +: CRYPT_OPTION_SMIME_DEFAULTATTRIBUTES 120 ; inline ! LDAP keyset options +: CRYPT_OPTION_KEYS_LDAP_OBJECTCLASS 121 ; inline ! Object class +: CRYPT_OPTION_KEYS_LDAP_OBJECTTYPE 122 ; inline ! Object type to fetch +: CRYPT_OPTION_KEYS_LDAP_FILTER 123 ; inline ! Query filter +: CRYPT_OPTION_KEYS_LDAP_CACERTNAME 124 ; inline ! CA certificate attribute name +: CRYPT_OPTION_KEYS_LDAP_CERTNAME 125 ; inline ! Certificate attribute name +: CRYPT_OPTION_KEYS_LDAP_CRLNAME 126 ; inline ! CRL attribute name +: CRYPT_OPTION_KEYS_LDAP_EMAILNAME 127 ; inline ! Email attribute name +: CRYPT_OPTION_DEVICE_PKCS11_DVR01 128 ; inline ! Name of first PKCS #11 driver +: CRYPT_OPTION_DEVICE_PKCS11_DVR02 129 ; inline ! Name of second PKCS #11 driver +: CRYPT_OPTION_DEVICE_PKCS11_DVR03 130 ; inline ! Name of third PKCS #11 driver +: CRYPT_OPTION_DEVICE_PKCS11_DVR04 131 ; inline ! Name of fourth PKCS #11 driver +: CRYPT_OPTION_DEVICE_PKCS11_DVR05 132 ; inline ! Name of fifth PKCS #11 driver +: CRYPT_OPTION_DEVICE_PKCS11_HARDWAREONLY 133 ; inline ! Use only hardware mechanisms +: CRYPT_OPTION_NET_SOCKS_SERVER 134 ; inline ! Socks server name +: CRYPT_OPTION_NET_SOCKS_USERNAME 135 ; inline ! Socks user name +: CRYPT_OPTION_NET_HTTP_PROXY 136 ; inline ! Web proxy server +: CRYPT_OPTION_NET_CONNECTTIMEOUT 137 ; inline ! Timeout for network connection setup +: CRYPT_OPTION_NET_READTIMEOUT 138 ; inline ! Timeout for network reads +: CRYPT_OPTION_NET_WRITETIMEOUT 139 ; inline ! Timeout for network writes +: CRYPT_OPTION_MISC_ASYNCINIT 140 ; inline ! Whether to init cryptlib async'ly +: CRYPT_OPTION_MISC_SIDECHANNELPROTECTION 141 ; inline ! Protect against side-channel attacks +: CRYPT_OPTION_CONFIGCHANGED 142 ; inline ! Whether in-mem.opts match on-disk ones +: CRYPT_OPTION_SELFTESTOK 143 ; inline ! Whether self-test was completed and OK +: CRYPT_OPTION_LAST 144 ; inline +: CRYPT_CTXINFO_FIRST 1000 ; inline ! ******************** +: CRYPT_CTXINFO_ALGO 1001 ; inline ! Algorithm +: CRYPT_CTXINFO_MODE 1002 ; inline ! Mode +: CRYPT_CTXINFO_NAME_ALGO 1003 ; inline ! Algorithm name +: CRYPT_CTXINFO_NAME_MODE 1004 ; inline ! Mode name +: CRYPT_CTXINFO_KEYSIZE 1005 ; inline ! Key size in bytes +: CRYPT_CTXINFO_BLOCKSIZE 1006 ; inline ! Block size +: CRYPT_CTXINFO_IVSIZE 1007 ; inline ! IV size +: CRYPT_CTXINFO_KEYING_ALGO 1008 ; inline ! Key processing algorithm +: CRYPT_CTXINFO_KEYING_ITERATIONS 1009 ; inline ! Key processing iterations +: CRYPT_CTXINFO_KEYING_SALT 1010 ; inline ! Key processing salt +: CRYPT_CTXINFO_KEYING_VALUE 1011 ; inline ! Value used to derive key +: CRYPT_CTXINFO_KEY 1012 ; inline ! Key +: CRYPT_CTXINFO_KEY_COMPONENTS 1013 ; inline ! Public-key components +: CRYPT_CTXINFO_IV 1014 ; inline ! IV +: CRYPT_CTXINFO_HASHVALUE 1015 ; inline ! Hash value +: CRYPT_CTXINFO_LABEL 1016 ; inline ! Label for private/secret key +: CRYPT_CTXINFO_PERSISTENT 1017 ; inline ! Obj.is backed by device or keyset +: CRYPT_CTXINFO_LAST 1018 ; inline +: CRYPT_CERTINFO_FIRST 2000 ; inline ! ************************ +: CRYPT_CERTINFO_SELFSIGNED 2001 ; inline ! Cert is self-signed +: CRYPT_CERTINFO_IMMUTABLE 2002 ; inline ! Cert is signed and immutable +: CRYPT_CERTINFO_XYZZY 2003 ; inline ! Cert is a magic just-works cert +: CRYPT_CERTINFO_CERTTYPE 2004 ; inline ! Certificate object type +: CRYPT_CERTINFO_FINGERPRINT 2005 ; inline ! Certificate fingerprints +: CRYPT_CERTINFO_FINGERPRINT_MD5 2005 ; inline +: CRYPT_CERTINFO_FINGERPRINT_SHA 2006 ; inline +: CRYPT_CERTINFO_CURRENT_CERTIFICATE 2007 ; inline ! Cursor mgt: Rel.pos in chain/CRL/OCSP +: CRYPT_CERTINFO_TRUSTED_USAGE 2008 ; inline ! Usage that cert is trusted for +: CRYPT_CERTINFO_TRUSTED_IMPLICIT 2009 ; inline ! Whether cert is implicitly trusted +: CRYPT_CERTINFO_SIGNATURELEVEL 2010 ; inline ! Amount of detail to include in sigs. +: CRYPT_CERTINFO_VERSION 2011 ; inline ! Cert.format version +: CRYPT_CERTINFO_SERIALNUMBER 2012 ; inline ! Serial number +: CRYPT_CERTINFO_SUBJECTPUBLICKEYINFO 2013 ; inline ! Public key +: CRYPT_CERTINFO_CERTIFICATE 2014 ; inline ! User certificate +: CRYPT_CERTINFO_USERCERTIFICATE 2014 ; inline +: CRYPT_CERTINFO_CACERTIFICATE 2015 ; inline ! CA certificate +: CRYPT_CERTINFO_ISSUERNAME 2016 ; inline ! Issuer DN +: CRYPT_CERTINFO_VALIDFROM 2017 ; inline ! Cert valid-from time +: CRYPT_CERTINFO_VALIDTO 2018 ; inline ! Cert valid-to time +: CRYPT_CERTINFO_SUBJECTNAME 2019 ; inline ! Subject DN +: CRYPT_CERTINFO_ISSUERUNIQUEID 2020 ; inline ! Issuer unique ID +: CRYPT_CERTINFO_SUBJECTUNIQUEID 2021 ; inline ! Subject unique ID +: CRYPT_CERTINFO_CERTREQUEST 2022 ; inline ! Cert.request (DN + public key) +: CRYPT_CERTINFO_THISUPDATE 2023 ; inline ! CRL/OCSP current-update time +: CRYPT_CERTINFO_NEXTUPDATE 2024 ; inline ! CRL/OCSP next-update time +: CRYPT_CERTINFO_REVOCATIONDATE 2025 ; inline ! CRL/OCSP cert-revocation time +: CRYPT_CERTINFO_REVOCATIONSTATUS 2026 ; inline ! OCSP revocation status +: CRYPT_CERTINFO_CERTSTATUS 2027 ; inline ! RTCS certificate status +: CRYPT_CERTINFO_DN 2028 ; inline ! Currently selected DN in string form +: CRYPT_CERTINFO_PKIUSER_ID 2029 ; inline ! PKI user ID +: CRYPT_CERTINFO_PKIUSER_ISSUEPASSWORD 2030 ; inline ! PKI user issue password +: CRYPT_CERTINFO_PKIUSER_REVPASSWORD 2031 ; inline ! PKI user revocation password +: CRYPT_CERTINFO_COUNTRYNAME 2100 ; inline ! countryName +: CRYPT_CERTINFO_STATEORPROVINCENAME 2101 ; inline ! stateOrProvinceName +: CRYPT_CERTINFO_LOCALITYNAME 2102 ; inline ! localityName +: CRYPT_CERTINFO_ORGANIZATIONNAME 2103 ; inline ! organizationName +: CRYPT_CERTINFO_ORGANISATIONNAME 2103 ; inline +: CRYPT_CERTINFO_ORGANIZATIONALUNITNAME 2104 ; inline ! organizationalUnitName +: CRYPT_CERTINFO_ORGANISATIONALUNITNAME 2104 ; inline +: CRYPT_CERTINFO_COMMONNAME 2105 ; inline ! commonName +: CRYPT_CERTINFO_OTHERNAME_TYPEID 2106 ; inline ! otherName.typeID +: CRYPT_CERTINFO_OTHERNAME_VALUE 2107 ; inline ! otherName.value +: CRYPT_CERTINFO_RFC822NAME 2108 ; inline ! rfc822Name +: CRYPT_CERTINFO_EMAIL 2108 ; inline +: CRYPT_CERTINFO_DNSNAME 2109 ; inline ! dNSName +: CRYPT_CERTINFO_DIRECTORYNAME 2110 ; inline ! directoryName +: CRYPT_CERTINFO_EDIPARTYNAME_NAMEASSIGNER 2111 ; inline ! ediPartyName.nameAssigner +: CRYPT_CERTINFO_EDIPARTYNAME_PARTYNAME 2112 ; inline ! ediPartyName.partyName +: CRYPT_CERTINFO_UNIFORMRESOURCEIDENTIFIER 2113 ; inline ! uniformResourceIdentifier +: CRYPT_CERTINFO_IPADDRESS 2114 ; inline ! iPAddress +: CRYPT_CERTINFO_REGISTEREDID 2115 ; inline ! registeredID +: CRYPT_CERTINFO_CHALLENGEPASSWORD 2200 ; inline ! 1 3 6 1 4 1 3029 3 1 4 cRLExtReason +: CRYPT_CERTINFO_CRLEXTREASON 2201 ; inline ! 1 3 6 1 4 1 3029 3 1 5 keyFeatures +: CRYPT_CERTINFO_KEYFEATURES 2202 ; inline ! 1 3 6 1 5 5 7 1 1 authorityInfoAccess +: CRYPT_CERTINFO_AUTHORITYINFOACCESS 2203 ; inline +: CRYPT_CERTINFO_AUTHORITYINFO_RTCS 2204 ; inline ! accessDescription.accessLocation +: CRYPT_CERTINFO_AUTHORITYINFO_OCSP 2205 ; inline ! accessDescription.accessLocation +: CRYPT_CERTINFO_AUTHORITYINFO_CAISSUERS 2206 ; inline ! accessDescription.accessLocation +: CRYPT_CERTINFO_AUTHORITYINFO_CERTSTORE 2207 ; inline ! accessDescription.accessLocation +: CRYPT_CERTINFO_AUTHORITYINFO_CRLS 2208 ; inline ! accessDescription.accessLocation +: CRYPT_CERTINFO_BIOMETRICINFO 2209 ; inline +: CRYPT_CERTINFO_BIOMETRICINFO_TYPE 2210 ; inline ! biometricData.typeOfData +: CRYPT_CERTINFO_BIOMETRICINFO_HASHALGO 2211 ; inline ! biometricData.hashAlgorithm +: CRYPT_CERTINFO_BIOMETRICINFO_HASH 2212 ; inline ! biometricData.dataHash +: CRYPT_CERTINFO_BIOMETRICINFO_URL 2213 ; inline ! biometricData.sourceDataUri +: CRYPT_CERTINFO_QCSTATEMENT 2214 ; inline +: CRYPT_CERTINFO_QCSTATEMENT_SEMANTICS 2215 ; inline ! qcStatement.statementInfo.semanticsIdentifier +: CRYPT_CERTINFO_QCSTATEMENT_REGISTRATIONAUTHORITY 2216 ; inline ! qcStatement.statementInfo.nameRegistrationAuthorities +: CRYPT_CERTINFO_OCSP_NONCE 2217 ; inline ! nonce +: CRYPT_CERTINFO_OCSP_RESPONSE 2218 ; inline +: CRYPT_CERTINFO_OCSP_RESPONSE_OCSP 2219 ; inline ! OCSP standard response +: CRYPT_CERTINFO_OCSP_NOCHECK 2220 ; inline ! 1 3 6 1 5 5 7 48 1 6 ocspArchiveCutoff +: CRYPT_CERTINFO_OCSP_ARCHIVECUTOFF 2221 ; inline ! 1 3 6 1 5 5 7 48 1 11 subjectInfoAccess +: CRYPT_CERTINFO_SUBJECTINFOACCESS 2222 ; inline +: CRYPT_CERTINFO_SUBJECTINFO_CAREPOSITORY 2223 ; inline ! accessDescription.accessLocation +: CRYPT_CERTINFO_SUBJECTINFO_TIMESTAMPING 2224 ; inline ! accessDescription.accessLocation +: CRYPT_CERTINFO_SIGG_DATEOFCERTGEN 2225 ; inline ! 1 3 36 8 3 2 siggProcuration +: CRYPT_CERTINFO_SIGG_PROCURATION 2226 ; inline +: CRYPT_CERTINFO_SIGG_PROCURE_COUNTRY 2227 ; inline ! country +: CRYPT_CERTINFO_SIGG_PROCURE_TYPEOFSUBSTITUTION 2228 ; inline ! typeOfSubstitution +: CRYPT_CERTINFO_SIGG_PROCURE_SIGNINGFOR 2229 ; inline ! signingFor.thirdPerson +: CRYPT_CERTINFO_SIGG_MONETARYLIMIT 2230 ; inline +: CRYPT_CERTINFO_SIGG_MONETARY_CURRENCY 2231 ; inline ! currency +: CRYPT_CERTINFO_SIGG_MONETARY_AMOUNT 2232 ; inline ! amount +: CRYPT_CERTINFO_SIGG_MONETARY_EXPONENT 2233 ; inline ! exponent +: CRYPT_CERTINFO_SIGG_RESTRICTION 2234 ; inline ! 1 3 101 1 4 1 strongExtranet +: CRYPT_CERTINFO_STRONGEXTRANET 2235 ; inline +: CRYPT_CERTINFO_STRONGEXTRANET_ZONE 2236 ; inline ! sxNetIDList.sxNetID.zone +: CRYPT_CERTINFO_STRONGEXTRANET_ID 2237 ; inline ! sxNetIDList.sxNetID.id +: CRYPT_CERTINFO_SUBJECTDIRECTORYATTRIBUTES 2238 ; inline +: CRYPT_CERTINFO_SUBJECTDIR_TYPE 2239 ; inline ! attribute.type +: CRYPT_CERTINFO_SUBJECTDIR_VALUES 2240 ; inline ! attribute.values +: CRYPT_CERTINFO_SUBJECTKEYIDENTIFIER 2241 ; inline ! 2 5 29 15 keyUsage +: CRYPT_CERTINFO_KEYUSAGE 2242 ; inline ! 2 5 29 16 privateKeyUsagePeriod +: CRYPT_CERTINFO_PRIVATEKEYUSAGEPERIOD 2243 ; inline +: CRYPT_CERTINFO_PRIVATEKEY_NOTBEFORE 2244 ; inline ! notBefore +: CRYPT_CERTINFO_PRIVATEKEY_NOTAFTER 2245 ; inline ! notAfter +: CRYPT_CERTINFO_SUBJECTALTNAME 2246 ; inline ! 2 5 29 18 issuerAltName +: CRYPT_CERTINFO_ISSUERALTNAME 2247 ; inline ! 2 5 29 19 basicConstraints +: CRYPT_CERTINFO_BASICCONSTRAINTS 2248 ; inline +: CRYPT_CERTINFO_CA 2249 ; inline ! cA +: CRYPT_CERTINFO_AUTHORITY 2249 ; inline +: CRYPT_CERTINFO_PATHLENCONSTRAINT 2250 ; inline ! pathLenConstraint +: CRYPT_CERTINFO_CRLNUMBER 2251 ; inline ! 2 5 29 21 cRLReason +: CRYPT_CERTINFO_CRLREASON 2252 ; inline ! 2 5 29 23 holdInstructionCode +: CRYPT_CERTINFO_HOLDINSTRUCTIONCODE 2253 ; inline ! 2 5 29 24 invalidityDate +: CRYPT_CERTINFO_INVALIDITYDATE 2254 ; inline ! 2 5 29 27 deltaCRLIndicator +: CRYPT_CERTINFO_DELTACRLINDICATOR 2255 ; inline ! 2 5 29 28 issuingDistributionPoint +: CRYPT_CERTINFO_ISSUINGDISTRIBUTIONPOINT 2256 ; inline +: CRYPT_CERTINFO_ISSUINGDIST_FULLNAME 2257 ; inline ! distributionPointName.fullName +: CRYPT_CERTINFO_ISSUINGDIST_USERCERTSONLY 2258 ; inline ! onlyContainsUserCerts +: CRYPT_CERTINFO_ISSUINGDIST_CACERTSONLY 2259 ; inline ! onlyContainsCACerts +: CRYPT_CERTINFO_ISSUINGDIST_SOMEREASONSONLY 2260 ; inline ! onlySomeReasons +: CRYPT_CERTINFO_ISSUINGDIST_INDIRECTCRL 2261 ; inline ! indirectCRL +: CRYPT_CERTINFO_CERTIFICATEISSUER 2262 ; inline ! 2 5 29 30 nameConstraints +: CRYPT_CERTINFO_NAMECONSTRAINTS 2263 ; inline +: CRYPT_CERTINFO_PERMITTEDSUBTREES 2264 ; inline ! permittedSubtrees +: CRYPT_CERTINFO_EXCLUDEDSUBTREES 2265 ; inline ! excludedSubtrees +: CRYPT_CERTINFO_CRLDISTRIBUTIONPOINT 2266 ; inline +: CRYPT_CERTINFO_CRLDIST_FULLNAME 2267 ; inline ! distributionPointName.fullName +: CRYPT_CERTINFO_CRLDIST_REASONS 2268 ; inline ! reasons +: CRYPT_CERTINFO_CRLDIST_CRLISSUER 2269 ; inline ! cRLIssuer +: CRYPT_CERTINFO_CERTIFICATEPOLICIES 2270 ; inline +: CRYPT_CERTINFO_CERTPOLICYID 2271 ; inline ! policyInformation.policyIdentifier +: CRYPT_CERTINFO_CERTPOLICY_CPSURI 2272 ; inline ! policyInformation.policyQualifiers.qualifier.cPSuri +: CRYPT_CERTINFO_CERTPOLICY_ORGANIZATION 2273 ; inline ! policyInformation.policyQualifiers.qualifier.userNotice.noticeRef.organization +: CRYPT_CERTINFO_CERTPOLICY_NOTICENUMBERS 2274 ; inline ! policyInformation.policyQualifiers.qualifier.userNotice.noticeRef.noticeNumbers +: CRYPT_CERTINFO_CERTPOLICY_EXPLICITTEXT 2275 ; inline ! policyInformation.policyQualifiers.qualifier.userNotice.explicitText +: CRYPT_CERTINFO_POLICYMAPPINGS 2276 ; inline +: CRYPT_CERTINFO_ISSUERDOMAINPOLICY 2277 ; inline ! policyMappings.issuerDomainPolicy +: CRYPT_CERTINFO_SUBJECTDOMAINPOLICY 2278 ; inline ! policyMappings.subjectDomainPolicy +: CRYPT_CERTINFO_AUTHORITYKEYIDENTIFIER 2279 ; inline +: CRYPT_CERTINFO_AUTHORITY_KEYIDENTIFIER 2280 ; inline ! keyIdentifier +: CRYPT_CERTINFO_AUTHORITY_CERTISSUER 2281 ; inline ! authorityCertIssuer +: CRYPT_CERTINFO_AUTHORITY_CERTSERIALNUMBER 2282 ; inline ! authorityCertSerialNumber +: CRYPT_CERTINFO_POLICYCONSTRAINTS 2283 ; inline +: CRYPT_CERTINFO_REQUIREEXPLICITPOLICY 2284 ; inline ! policyConstraints.requireExplicitPolicy +: CRYPT_CERTINFO_INHIBITPOLICYMAPPING 2285 ; inline ! policyConstraints.inhibitPolicyMapping +: CRYPT_CERTINFO_EXTKEYUSAGE 2286 ; inline +: CRYPT_CERTINFO_EXTKEY_MS_INDIVIDUALCODESIGNING 2287 ; inline ! individualCodeSigning +: CRYPT_CERTINFO_EXTKEY_MS_COMMERCIALCODESIGNING 2288 ; inline ! commercialCodeSigning +: CRYPT_CERTINFO_EXTKEY_MS_CERTTRUSTLISTSIGNING 2289 ; inline ! certTrustListSigning +: CRYPT_CERTINFO_EXTKEY_MS_TIMESTAMPSIGNING 2290 ; inline ! timeStampSigning +: CRYPT_CERTINFO_EXTKEY_MS_SERVERGATEDCRYPTO 2291 ; inline ! serverGatedCrypto +: CRYPT_CERTINFO_EXTKEY_MS_ENCRYPTEDFILESYSTEM 2292 ; inline ! encrypedFileSystem +: CRYPT_CERTINFO_EXTKEY_SERVERAUTH 2293 ; inline ! serverAuth +: CRYPT_CERTINFO_EXTKEY_CLIENTAUTH 2294 ; inline ! clientAuth +: CRYPT_CERTINFO_EXTKEY_CODESIGNING 2295 ; inline ! codeSigning +: CRYPT_CERTINFO_EXTKEY_EMAILPROTECTION 2296 ; inline ! emailProtection +: CRYPT_CERTINFO_EXTKEY_IPSECENDSYSTEM 2297 ; inline ! ipsecEndSystem +: CRYPT_CERTINFO_EXTKEY_IPSECTUNNEL 2298 ; inline ! ipsecTunnel +: CRYPT_CERTINFO_EXTKEY_IPSECUSER 2299 ; inline ! ipsecUser +: CRYPT_CERTINFO_EXTKEY_TIMESTAMPING 2300 ; inline ! timeStamping +: CRYPT_CERTINFO_EXTKEY_OCSPSIGNING 2301 ; inline ! ocspSigning +: CRYPT_CERTINFO_EXTKEY_DIRECTORYSERVICE 2302 ; inline ! directoryService +: CRYPT_CERTINFO_EXTKEY_ANYKEYUSAGE 2303 ; inline ! anyExtendedKeyUsage +: CRYPT_CERTINFO_EXTKEY_NS_SERVERGATEDCRYPTO 2304 ; inline ! serverGatedCrypto +: CRYPT_CERTINFO_EXTKEY_VS_SERVERGATEDCRYPTO_CA 2305 ; inline ! serverGatedCrypto CA +: CRYPT_CERTINFO_FRESHESTCRL 2306 ; inline +: CRYPT_CERTINFO_FRESHESTCRL_FULLNAME 2307 ; inline ! distributionPointName.fullName +: CRYPT_CERTINFO_FRESHESTCRL_REASONS 2308 ; inline ! reasons +: CRYPT_CERTINFO_FRESHESTCRL_CRLISSUER 2309 ; inline ! cRLIssuer +: CRYPT_CERTINFO_INHIBITANYPOLICY 2310 ; inline ! 2 16 840 1 113730 1 x Netscape extensions +: CRYPT_CERTINFO_NS_CERTTYPE 2311 ; inline ! netscape-cert-type +: CRYPT_CERTINFO_NS_BASEURL 2312 ; inline ! netscape-base-url +: CRYPT_CERTINFO_NS_REVOCATIONURL 2313 ; inline ! netscape-revocation-url +: CRYPT_CERTINFO_NS_CAREVOCATIONURL 2314 ; inline ! netscape-ca-revocation-url +: CRYPT_CERTINFO_NS_CERTRENEWALURL 2315 ; inline ! netscape-cert-renewal-url +: CRYPT_CERTINFO_NS_CAPOLICYURL 2316 ; inline ! netscape-ca-policy-url +: CRYPT_CERTINFO_NS_SSLSERVERNAME 2317 ; inline ! netscape-ssl-server-name +: CRYPT_CERTINFO_NS_COMMENT 2318 ; inline ! netscape-comment +: CRYPT_CERTINFO_SET_HASHEDROOTKEY 2319 ; inline +: CRYPT_CERTINFO_SET_ROOTKEYTHUMBPRINT 2320 ; inline ! rootKeyThumbPrint +: CRYPT_CERTINFO_SET_CERTIFICATETYPE 2321 ; inline ! 2 23 42 7 2 SET merchantData +: CRYPT_CERTINFO_SET_MERCHANTDATA 2322 ; inline +: CRYPT_CERTINFO_SET_MERID 2323 ; inline ! merID +: CRYPT_CERTINFO_SET_MERACQUIRERBIN 2324 ; inline ! merAcquirerBIN +: CRYPT_CERTINFO_SET_MERCHANTLANGUAGE 2325 ; inline ! merNames.language +: CRYPT_CERTINFO_SET_MERCHANTNAME 2326 ; inline ! merNames.name +: CRYPT_CERTINFO_SET_MERCHANTCITY 2327 ; inline ! merNames.city +: CRYPT_CERTINFO_SET_MERCHANTSTATEPROVINCE 2328 ; inline ! merNames.stateProvince +: CRYPT_CERTINFO_SET_MERCHANTPOSTALCODE 2329 ; inline ! merNames.postalCode +: CRYPT_CERTINFO_SET_MERCHANTCOUNTRYNAME 2330 ; inline ! merNames.countryName +: CRYPT_CERTINFO_SET_MERCOUNTRY 2331 ; inline ! merCountry +: CRYPT_CERTINFO_SET_MERAUTHFLAG 2332 ; inline ! merAuthFlag +: CRYPT_CERTINFO_SET_CERTCARDREQUIRED 2333 ; inline ! 2 23 42 7 4 SET tunneling +: CRYPT_CERTINFO_SET_TUNNELING 2334 ; inline +: CRYPT_CERTINFO_SET_TUNNELLING 2334 ; inline +: CRYPT_CERTINFO_SET_TUNNELINGFLAG 2335 ; inline ! tunneling +: CRYPT_CERTINFO_SET_TUNNELLINGFLAG 2335 ; inline +: CRYPT_CERTINFO_SET_TUNNELINGALGID 2336 ; inline ! tunnelingAlgID +: CRYPT_CERTINFO_SET_TUNNELLINGALGID 2336 ; inline ! S/MIME attributes +: CRYPT_CERTINFO_CMS_CONTENTTYPE 2500 ; inline ! 1 2 840 113549 1 9 4 messageDigest +: CRYPT_CERTINFO_CMS_MESSAGEDIGEST 2501 ; inline ! 1 2 840 113549 1 9 5 signingTime +: CRYPT_CERTINFO_CMS_SIGNINGTIME 2502 ; inline ! 1 2 840 113549 1 9 6 counterSignature +: CRYPT_CERTINFO_CMS_COUNTERSIGNATURE 2503 ; inline ! counterSignature +: CRYPT_CERTINFO_CMS_SIGNINGDESCRIPTION 2504 ; inline ! 1 2 840 113549 1 9 15 sMIMECapabilities +: CRYPT_CERTINFO_CMS_SMIMECAPABILITIES 2505 ; inline +: CRYPT_CERTINFO_CMS_SMIMECAP_3DES 2506 ; inline ! 3DES encryption +: CRYPT_CERTINFO_CMS_SMIMECAP_AES 2507 ; inline ! AES encryption +: CRYPT_CERTINFO_CMS_SMIMECAP_CAST128 2508 ; inline ! CAST-128 encryption +: CRYPT_CERTINFO_CMS_SMIMECAP_IDEA 2509 ; inline ! IDEA encryption +: CRYPT_CERTINFO_CMS_SMIMECAP_RC2 2510 ; inline ! RC2 encryption (w.128 key) +: CRYPT_CERTINFO_CMS_SMIMECAP_RC5 2511 ; inline ! RC5 encryption (w.128 key) +: CRYPT_CERTINFO_CMS_SMIMECAP_SKIPJACK 2512 ; inline ! Skipjack encryption +: CRYPT_CERTINFO_CMS_SMIMECAP_DES 2513 ; inline ! DES encryption +: CRYPT_CERTINFO_CMS_SMIMECAP_PREFERSIGNEDDATA 2514 ; inline ! preferSignedData +: CRYPT_CERTINFO_CMS_SMIMECAP_CANNOTDECRYPTANY 2515 ; inline ! canNotDecryptAny +: CRYPT_CERTINFO_CMS_RECEIPTREQUEST 2516 ; inline +: CRYPT_CERTINFO_CMS_RECEIPT_CONTENTIDENTIFIER 2517 ; inline ! contentIdentifier +: CRYPT_CERTINFO_CMS_RECEIPT_FROM 2518 ; inline ! receiptsFrom +: CRYPT_CERTINFO_CMS_RECEIPT_TO 2519 ; inline ! receiptsTo +: CRYPT_CERTINFO_CMS_SECURITYLABEL 2520 ; inline +: CRYPT_CERTINFO_CMS_SECLABEL_POLICY 2521 ; inline ! securityPolicyIdentifier +: CRYPT_CERTINFO_CMS_SECLABEL_CLASSIFICATION 2522 ; inline ! securityClassification +: CRYPT_CERTINFO_CMS_SECLABEL_PRIVACYMARK 2523 ; inline ! privacyMark +: CRYPT_CERTINFO_CMS_SECLABEL_CATTYPE 2524 ; inline ! securityCategories.securityCategory.type +: CRYPT_CERTINFO_CMS_SECLABEL_CATVALUE 2525 ; inline ! securityCategories.securityCategory.value +: CRYPT_CERTINFO_CMS_MLEXPANSIONHISTORY 2526 ; inline +: CRYPT_CERTINFO_CMS_MLEXP_ENTITYIDENTIFIER 2527 ; inline ! mlData.mailListIdentifier.issuerAndSerialNumber +: CRYPT_CERTINFO_CMS_MLEXP_TIME 2528 ; inline ! mlData.expansionTime +: CRYPT_CERTINFO_CMS_MLEXP_NONE 2529 ; inline ! mlData.mlReceiptPolicy.none +: CRYPT_CERTINFO_CMS_MLEXP_INSTEADOF 2530 ; inline ! mlData.mlReceiptPolicy.insteadOf.generalNames.generalName +: CRYPT_CERTINFO_CMS_MLEXP_INADDITIONTO 2531 ; inline ! mlData.mlReceiptPolicy.inAdditionTo.generalNames.generalName +: CRYPT_CERTINFO_CMS_CONTENTHINTS 2532 ; inline +: CRYPT_CERTINFO_CMS_CONTENTHINT_DESCRIPTION 2533 ; inline ! contentDescription +: CRYPT_CERTINFO_CMS_CONTENTHINT_TYPE 2534 ; inline ! contentType +: CRYPT_CERTINFO_CMS_EQUIVALENTLABEL 2535 ; inline +: CRYPT_CERTINFO_CMS_EQVLABEL_POLICY 2536 ; inline ! securityPolicyIdentifier +: CRYPT_CERTINFO_CMS_EQVLABEL_CLASSIFICATION 2537 ; inline ! securityClassification +: CRYPT_CERTINFO_CMS_EQVLABEL_PRIVACYMARK 2538 ; inline ! privacyMark +: CRYPT_CERTINFO_CMS_EQVLABEL_CATTYPE 2539 ; inline ! securityCategories.securityCategory.type +: CRYPT_CERTINFO_CMS_EQVLABEL_CATVALUE 2540 ; inline ! securityCategories.securityCategory.value +: CRYPT_CERTINFO_CMS_SIGNINGCERTIFICATE 2541 ; inline +: CRYPT_CERTINFO_CMS_SIGNINGCERT_ESSCERTID 2542 ; inline ! certs.essCertID +: CRYPT_CERTINFO_CMS_SIGNINGCERT_POLICIES 2543 ; inline ! policies.policyInformation.policyIdentifier +: CRYPT_CERTINFO_CMS_SIGNATUREPOLICYID 2544 ; inline +: CRYPT_CERTINFO_CMS_SIGPOLICYID 2545 ; inline ! sigPolicyID +: CRYPT_CERTINFO_CMS_SIGPOLICYHASH 2546 ; inline ! sigPolicyHash +: CRYPT_CERTINFO_CMS_SIGPOLICY_CPSURI 2547 ; inline ! sigPolicyQualifiers.sigPolicyQualifier.cPSuri +: CRYPT_CERTINFO_CMS_SIGPOLICY_ORGANIZATION 2548 ; inline ! sigPolicyQualifiers.sigPolicyQualifier.userNotice.noticeRef.organization +: CRYPT_CERTINFO_CMS_SIGPOLICY_NOTICENUMBERS 2549 ; inline ! sigPolicyQualifiers.sigPolicyQualifier.userNotice.noticeRef.noticeNumbers +: CRYPT_CERTINFO_CMS_SIGPOLICY_EXPLICITTEXT 2550 ; inline ! sigPolicyQualifiers.sigPolicyQualifier.userNotice.explicitText +: CRYPT_CERTINFO_CMS_SIGTYPEIDENTIFIER 2551 ; inline +: CRYPT_CERTINFO_CMS_SIGTYPEID_ORIGINATORSIG 2552 ; inline ! originatorSig +: CRYPT_CERTINFO_CMS_SIGTYPEID_DOMAINSIG 2553 ; inline ! domainSig +: CRYPT_CERTINFO_CMS_SIGTYPEID_ADDITIONALATTRIBUTES 2554 ; inline ! additionalAttributesSig +: CRYPT_CERTINFO_CMS_SIGTYPEID_REVIEWSIG 2555 ; inline ! reviewSig +: CRYPT_CERTINFO_CMS_NONCE 2556 ; inline ! randomNonce +: CRYPT_CERTINFO_SCEP_MESSAGETYPE 2557 ; inline ! messageType +: CRYPT_CERTINFO_SCEP_PKISTATUS 2558 ; inline ! pkiStatus +: CRYPT_CERTINFO_SCEP_FAILINFO 2559 ; inline ! failInfo +: CRYPT_CERTINFO_SCEP_SENDERNONCE 2560 ; inline ! senderNonce +: CRYPT_CERTINFO_SCEP_RECIPIENTNONCE 2561 ; inline ! recipientNonce +: CRYPT_CERTINFO_SCEP_TRANSACTIONID 2562 ; inline ! transID +: CRYPT_CERTINFO_CMS_SPCAGENCYINFO 2563 ; inline +: CRYPT_CERTINFO_CMS_SPCAGENCYURL 2564 ; inline ! spcAgencyInfo.url +: CRYPT_CERTINFO_CMS_SPCSTATEMENTTYPE 2565 ; inline +: CRYPT_CERTINFO_CMS_SPCSTMT_INDIVIDUALCODESIGNING 2566 ; inline ! individualCodeSigning +: CRYPT_CERTINFO_CMS_SPCSTMT_COMMERCIALCODESIGNING 2567 ; inline ! commercialCodeSigning +: CRYPT_CERTINFO_CMS_SPCOPUSINFO 2568 ; inline +: CRYPT_CERTINFO_CMS_SPCOPUSINFO_NAME 2569 ; inline ! spcOpusInfo.name +: CRYPT_CERTINFO_CMS_SPCOPUSINFO_URL 2570 ; inline ! spcOpusInfo.url +: CRYPT_CERTINFO_LAST 2571 ; inline +: CRYPT_KEYINFO_FIRST 3000 ; inline ! ******************* +: CRYPT_KEYINFO_QUERY 3001 ; inline ! Keyset query +: CRYPT_KEYINFO_QUERY_REQUESTS 3002 ; inline ! Query of requests in cert store +: CRYPT_KEYINFO_LAST 3003 ; inline +: CRYPT_DEVINFO_FIRST 4000 ; inline ! ******************* +: CRYPT_DEVINFO_INITIALISE 4001 ; inline ! Initialise device for use +: CRYPT_DEVINFO_INITIALIZE 4001 ; inline +: CRYPT_DEVINFO_AUTHENT_USER 4002 ; inline ! Authenticate user to device +: CRYPT_DEVINFO_AUTHENT_SUPERVISOR 4003 ; inline ! Authenticate supervisor to dev. +: CRYPT_DEVINFO_SET_AUTHENT_USER 4004 ; inline ! Set user authent.value +: CRYPT_DEVINFO_SET_AUTHENT_SUPERVISOR 4005 ; inline ! Set supervisor auth.val. +: CRYPT_DEVINFO_ZEROISE 4006 ; inline ! Zeroise device +: CRYPT_DEVINFO_ZEROIZE 4006 ; inline +: CRYPT_DEVINFO_LOGGEDIN 4007 ; inline ! Whether user is logged in +: CRYPT_DEVINFO_LABEL 4008 ; inline ! Device/token label +: CRYPT_DEVINFO_LAST 4009 ; inline +: CRYPT_ENVINFO_FIRST 5000 ; inline ! ********************* +: CRYPT_ENVINFO_DATASIZE 5001 ; inline ! Data size information +: CRYPT_ENVINFO_COMPRESSION 5002 ; inline ! Compression information +: CRYPT_ENVINFO_CONTENTTYPE 5003 ; inline ! Inner CMS content type +: CRYPT_ENVINFO_DETACHEDSIGNATURE 5004 ; inline ! Generate CMS detached signature +: CRYPT_ENVINFO_SIGNATURE_RESULT 5005 ; inline ! Signature check result +: CRYPT_ENVINFO_MAC 5006 ; inline ! Use MAC instead of encrypting +: CRYPT_ENVINFO_PASSWORD 5007 ; inline ! User password +: CRYPT_ENVINFO_KEY 5008 ; inline ! Conventional encryption key +: CRYPT_ENVINFO_SIGNATURE 5009 ; inline ! Signature/signature check key +: CRYPT_ENVINFO_SIGNATURE_EXTRADATA 5010 ; inline ! Extra information added to CMS sigs +: CRYPT_ENVINFO_RECIPIENT 5011 ; inline ! Recipient email address +: CRYPT_ENVINFO_PUBLICKEY 5012 ; inline ! PKC encryption key +: CRYPT_ENVINFO_PRIVATEKEY 5013 ; inline ! PKC decryption key +: CRYPT_ENVINFO_PRIVATEKEY_LABEL 5014 ; inline ! Label of PKC decryption key +: CRYPT_ENVINFO_ORIGINATOR 5015 ; inline ! Originator info/key +: CRYPT_ENVINFO_SESSIONKEY 5016 ; inline ! Session key +: CRYPT_ENVINFO_HASH 5017 ; inline ! Hash value +: CRYPT_ENVINFO_TIMESTAMP 5018 ; inline ! Timestamp information +: CRYPT_ENVINFO_KEYSET_SIGCHECK 5019 ; inline ! Signature check keyset +: CRYPT_ENVINFO_KEYSET_ENCRYPT 5020 ; inline ! PKC encryption keyset +: CRYPT_ENVINFO_KEYSET_DECRYPT 5021 ; inline ! PKC decryption keyset +: CRYPT_ENVINFO_LAST 5022 ; inline +: CRYPT_SESSINFO_FIRST 6000 ; inline ! ******************** +: CRYPT_SESSINFO_ACTIVE 6001 ; inline ! Whether session is active +: CRYPT_SESSINFO_CONNECTIONACTIVE 6002 ; inline ! Whether network connection is active +: CRYPT_SESSINFO_USERNAME 6003 ; inline ! User name +: CRYPT_SESSINFO_PASSWORD 6004 ; inline ! Password +: CRYPT_SESSINFO_PRIVATEKEY 6005 ; inline ! Server/client private key +: CRYPT_SESSINFO_KEYSET 6006 ; inline ! Certificate store +: CRYPT_SESSINFO_AUTHRESPONSE 6007 ; inline ! Session authorisation OK +: CRYPT_SESSINFO_SERVER_NAME 6008 ; inline ! Server name +: CRYPT_SESSINFO_SERVER_PORT 6009 ; inline ! Server port number +: CRYPT_SESSINFO_SERVER_FINGERPRINT 6010 ; inline ! Server key fingerprint +: CRYPT_SESSINFO_CLIENT_NAME 6011 ; inline ! Client name +: CRYPT_SESSINFO_CLIENT_PORT 6012 ; inline ! Client port number +: CRYPT_SESSINFO_SESSION 6013 ; inline ! Transport mechanism +: CRYPT_SESSINFO_NETWORKSOCKET 6014 ; inline ! User-supplied network socket +: CRYPT_SESSINFO_VERSION 6015 ; inline ! Protocol version +: CRYPT_SESSINFO_REQUEST 6016 ; inline ! Cert.request object +: CRYPT_SESSINFO_RESPONSE 6017 ; inline ! Cert.response object +: CRYPT_SESSINFO_CACERTIFICATE 6018 ; inline ! Issuing CA certificate +: CRYPT_SESSINFO_TSP_MSGIMPRINT 6019 ; inline ! TSP message imprint +: CRYPT_SESSINFO_CMP_REQUESTTYPE 6020 ; inline ! Request type +: CRYPT_SESSINFO_CMP_PKIBOOT 6021 ; inline ! Enable PKIBoot facility +: CRYPT_SESSINFO_CMP_PRIVKEYSET 6022 ; inline ! Private-key keyset +: CRYPT_SESSINFO_SSH_CHANNEL 6023 ; inline ! SSH current channel +: CRYPT_SESSINFO_SSH_CHANNEL_TYPE 6024 ; inline ! SSH channel type +: CRYPT_SESSINFO_SSH_CHANNEL_ARG1 6025 ; inline ! SSH channel argument 1 +: CRYPT_SESSINFO_SSH_CHANNEL_ARG2 6026 ; inline ! SSH channel argument 2 +: CRYPT_SESSINFO_SSH_CHANNEL_ACTIVE 6027 ; inline ! SSH channel active +: CRYPT_SESSINFO_LAST 6028 ; inline +: CRYPT_USERINFO_FIRST 7000 ; inline ! ******************** +: CRYPT_USERINFO_PASSWORD 7001 ; inline ! Password +: CRYPT_USERINFO_CAKEY_CERTSIGN 7002 ; inline ! CA cert signing key +: CRYPT_USERINFO_CAKEY_CRLSIGN 7003 ; inline ! CA CRL signing key +: CRYPT_USERINFO_CAKEY_RTCSSIGN 7004 ; inline ! CA RTCS signing key +: CRYPT_USERINFO_CAKEY_OCSPSIGN 7005 ; inline ! CA OCSP signing key +: CRYPT_USERINFO_LAST 7006 ; inline +: CRYPT_ATTRIBUTE_LAST 7006 ; inline + +TYPEDEF: int CRYPT_ATTRIBUTE_TYPE + +! =============================================== +! Attribute Subtypes and Related Values +! =============================================== + +! Flags for the X.509 keyUsage extension +: CRYPT_KEYUSAGE_NONE 0x000 ; inline +: CRYPT_KEYUSAGE_DIGITALSIGNATURE 0x001 ; inline +: CRYPT_KEYUSAGE_NONREPUDIATION 0x002 ; inline +: CRYPT_KEYUSAGE_KEYENCIPHERMENT 0x004 ; inline +: CRYPT_KEYUSAGE_DATAENCIPHERMENT 0x008 ; inline +: CRYPT_KEYUSAGE_KEYAGREEMENT 0x010 ; inline +: CRYPT_KEYUSAGE_KEYCERTSIGN 0x020 ; inline +: CRYPT_KEYUSAGE_CRLSIGN 0x040 ; inline +: CRYPT_KEYUSAGE_ENCIPHERONLY 0x080 ; inline +: CRYPT_KEYUSAGE_DECIPHERONLY 0x100 ; inline +: CRYPT_KEYUSAGE_LAST 0x200 ; inline ! Last possible value + +! X.509 cRLReason and cryptlib cRLExtReason codes +: CRYPT_CRLREASON_UNSPECIFIED 0 ; inline +: CRYPT_CRLREASON_KEYCOMPROMISE 1 ; inline +: CRYPT_CRLREASON_CACOMPROMISE 2 ; inline +: CRYPT_CRLREASON_AFFILIATIONCHANGED 3 ; inline +: CRYPT_CRLREASON_SUPERSEDED 4 ; inline +: CRYPT_CRLREASON_CESSATIONOFOPERATION 5 ; inline +: CRYPT_CRLREASON_CERTIFICATEHOLD 6 ; inline +: CRYPT_CRLREASON_REMOVEFROMCRL 8 ; inline +: CRYPT_CRLREASON_PRIVILEGEWITHDRAWN 9 ; inline +: CRYPT_CRLREASON_AACOMPROMISE 10 ; inline +: CRYPT_CRLREASON_LAST 11 ; inline ! End of standard CRL reasons +: CRYPT_CRLREASON_NEVERVALID 20 ; inline +: CRYPT_CRLEXTREASON_LAST 21 ; inline + +! X.509 CRL reason flags. These identify the same thing as the cRLReason +! codes but allow for multiple reasons to be specified. Note that these +! don't follow the X.509 naming since in that scheme the enumerated types +! and bitflags have the same names +: CRYPT_CRLREASONFLAG_UNUSED 0x001 ; inline +: CRYPT_CRLREASONFLAG_KEYCOMPROMISE 0x002 ; inline +: CRYPT_CRLREASONFLAG_CACOMPROMISE 0x004 ; inline +: CRYPT_CRLREASONFLAG_AFFILIATIONCHANGED 0x008 ; inline +: CRYPT_CRLREASONFLAG_SUPERSEDED 0x010 ; inline +: CRYPT_CRLREASONFLAG_CESSATIONOFOPERATION 0x020 ; inline +: CRYPT_CRLREASONFLAG_CERTIFICATEHOLD 0x040 ; inline +: CRYPT_CRLREASONFLAG_LAST 0x080 ; inline ! Last poss.value + +! X.509 CRL holdInstruction codes +: CRYPT_HOLDINSTRUCTION_NONE 0 ; inline +: CRYPT_HOLDINSTRUCTION_CALLISSUER 1 ; inline +: CRYPT_HOLDINSTRUCTION_REJECT 2 ; inline +: CRYPT_HOLDINSTRUCTION_PICKUPTOKEN 3 ; inline +: CRYPT_HOLDINSTRUCTION_LAST 4 ; inline + +! Certificate checking compliance levels +: CRYPT_COMPLIANCELEVEL_OBLIVIOUS 0 ; inline +: CRYPT_COMPLIANCELEVEL_REDUCED 1 ; inline +: CRYPT_COMPLIANCELEVEL_STANDARD 2 ; inline +: CRYPT_COMPLIANCELEVEL_PKIX_PARTIAL 3 ; inline +: CRYPT_COMPLIANCELEVEL_PKIX_FULL 4 ; inline +: CRYPT_COMPLIANCELEVEL_LAST 5 ; inline + +! Flags for the Netscape netscape-cert-type extension +: CRYPT_NS_CERTTYPE_SSLCLIENT 0x001 ; inline +: CRYPT_NS_CERTTYPE_SSLSERVER 0x002 ; inline +: CRYPT_NS_CERTTYPE_SMIME 0x004 ; inline +: CRYPT_NS_CERTTYPE_OBJECTSIGNING 0x008 ; inline +: CRYPT_NS_CERTTYPE_RESERVED 0x010 ; inline +: CRYPT_NS_CERTTYPE_SSLCA 0x020 ; inline +: CRYPT_NS_CERTTYPE_SMIMECA 0x040 ; inline +: CRYPT_NS_CERTTYPE_OBJECTSIGNINGCA 0x080 ; inline +: CRYPT_NS_CERTTYPE_LAST 0x100 ; inline ! Last possible value + +! Flags for the SET certificate-type extension +: CRYPT_SET_CERTTYPE_CARD 0x001 ; inline +: CRYPT_SET_CERTTYPE_MER 0x002 ; inline +: CRYPT_SET_CERTTYPE_PGWY 0x004 ; inline +: CRYPT_SET_CERTTYPE_CCA 0x008 ; inline +: CRYPT_SET_CERTTYPE_MCA 0x010 ; inline +: CRYPT_SET_CERTTYPE_PCA 0x020 ; inline +: CRYPT_SET_CERTTYPE_GCA 0x040 ; inline +: CRYPT_SET_CERTTYPE_BCA 0x080 ; inline +: CRYPT_SET_CERTTYPE_RCA 0x100 ; inline +: CRYPT_SET_CERTTYPE_ACQ 0x200 ; inline +: CRYPT_SET_CERTTYPE_LAST 0x400 ; inline ! Last possible value + +! CMS contentType values +! CRYPT_CONTENT_TYPE +: CRYPT_CONTENT_NONE 0 ; inline +: CRYPT_CONTENT_DATA 1 ; inline +: CRYPT_CONTENT_SIGNEDDATA 2 ; inline +: CRYPT_CONTENT_ENVELOPEDDATA 3 ; inline +: CRYPT_CONTENT_SIGNEDANDENVELOPEDDATA 4 ; inline +: CRYPT_CONTENT_DIGESTEDDATA 5 ; inline +: CRYPT_CONTENT_ENCRYPTEDDATA 6 ; inline +: CRYPT_CONTENT_COMPRESSEDDATA 7 ; inline +: CRYPT_CONTENT_TSTINFO 8 ; inline +: CRYPT_CONTENT_SPCINDIRECTDATACONTEXT 9 ; inline +: CRYPT_CONTENT_RTCSREQUEST 10 ; inline +: CRYPT_CONTENT_RTCSRESPONSE 11 ; inline +: CRYPT_CONTENT_RTCSRESPONSE_EXT 12 ; inline +: CRYPT_CONTENT_LAST 13 ; inline + +! ESS securityClassification codes +: CRYPT_CLASSIFICATION_UNMARKED 0 ; inline +: CRYPT_CLASSIFICATION_UNCLASSIFIED 1 ; inline +: CRYPT_CLASSIFICATION_RESTRICTED 2 ; inline +: CRYPT_CLASSIFICATION_CONFIDENTIAL 3 ; inline +: CRYPT_CLASSIFICATION_SECRET 4 ; inline +: CRYPT_CLASSIFICATION_TOP_SECRET 5 ; inline +: CRYPT_CLASSIFICATION_LAST 255 ; inline + +! RTCS certificate status +: CRYPT_CERTSTATUS_VALID 0 ; inline +: CRYPT_CERTSTATUS_NOTVALID 1 ; inline +: CRYPT_CERTSTATUS_NONAUTHORITATIVE 2 ; inline +: CRYPT_CERTSTATUS_UNKNOWN 3 ; inline + +! OCSP revocation status +: CRYPT_OCSPSTATUS_NOTREVOKED 0 ; inline +: CRYPT_OCSPSTATUS_REVOKED 1 ; inline +: CRYPT_OCSPSTATUS_UNKNOWN 2 ; inline + +! The amount of detail to include in signatures when signing certificate +! objects +! CRYPT_SIGNATURELEVEL_TYPE +: CRYPT_SIGNATURELEVEL_NONE 0 ; inline ! Include only signature +: CRYPT_SIGNATURELEVEL_SIGNERCERT 1 ; inline ! Include signer cert +: CRYPT_SIGNATURELEVEL_ALL 2 ; inline ! Include all relevant info +: CRYPT_SIGNATURELEVEL_LAST 3 ; inline ! Last possible sig.level type + +! The certificate export format type, which defines the format in which a +! certificate object is exported +! CRYPT_CERTFORMAT_TYPE +: CRYPT_CERTFORMAT_NONE 0 ; inline ! No certificate format +: CRYPT_CERTFORMAT_CERTIFICATE 1 ; inline ! DER-encoded certificate +: CRYPT_CERTFORMAT_CERTCHAIN 2 ; inline ! PKCS #7 certificate chain +: CRYPT_CERTFORMAT_TEXT_CERTIFICATE 3 ; inline ! base-64 wrapped cert +: CRYPT_CERTFORMAT_TEXT_CERTCHAIN 4 ; inline ! base-64 wrapped cert chain +: CRYPT_CERTFORMAT_XML_CERTIFICATE 5 ; inline ! XML wrapped cert +: CRYPT_CERTFORMAT_XML_CERTCHAIN 6 ; inline ! XML wrapped cert chain +: CRYPT_CERTFORMAT_LAST 7 ; inline ! Last possible cert.format type + +TYPEDEF: int CRYPT_CERTFORMAT_TYPE + +! CMP request types +! CRYPT_REQUESTTYPE_TYPE +: CRYPT_REQUESTTYPE_NONE 0 ; inline ! No request type +: CRYPT_REQUESTTYPE_INITIALISATION 1 ; inline ! Initialisation request +: CRYPT_REQUESTTYPE_INITIALIZATION 1 ; inline +: CRYPT_REQUESTTYPE_CERTIFICATE 2 ; inline ! Certification request +: CRYPT_REQUESTTYPE_KEYUPDATE 3 ; inline ! Key update request +: CRYPT_REQUESTTYPE_REVOCATION 4 ; inline ! Cert revocation request +: CRYPT_REQUESTTYPE_PKIBOOT 5 ; inline ! PKIBoot request +: CRYPT_REQUESTTYPE_LAST 6 ; inline ! Last possible request type + +! Key ID types +! CRYPT_KEYID_TYPE +: CRYPT_KEYID_NONE 0 ; inline ! No key ID type +: CRYPT_KEYID_NAME 1 ; inline ! Key owner name +: CRYPT_KEYID_URI 2 ; inline ! Key owner URI +: CRYPT_KEYID_EMAIL 2 ; inline ! Synonym: owner email addr. +: CRYPT_KEYID_LAST 3 ; inline ! Last possible key ID type + +TYPEDEF: int CRYPT_KEYID_TYPE + +! The encryption object types +! CRYPT_OBJECT_TYPE +: CRYPT_OBJECT_NONE 0 ; inline ! No object type +: CRYPT_OBJECT_ENCRYPTED_KEY 1 ; inline ! Conventionally encrypted key +: CRYPT_OBJECT_PKCENCRYPTED_KEY 2 ; inline ! PKC-encrypted key +: CRYPT_OBJECT_KEYAGREEMENT 3 ; inline ! Key agreement information +: CRYPT_OBJECT_SIGNATURE 4 ; inline ! Signature +: CRYPT_OBJECT_LAST 5 ; inline ! Last possible object type + +! Object/attribute error type information +! CRYPT_ERRTYPE_TYPE +: CRYPT_ERRTYPE_NONE 0 ; inline ! No error information +: CRYPT_ERRTYPE_ATTR_SIZE 1 ; inline ! Attribute data too small or large +: CRYPT_ERRTYPE_ATTR_VALUE 2 ; inline ! Attribute value is invalid +: CRYPT_ERRTYPE_ATTR_ABSENT 3 ; inline ! Required attribute missing +: CRYPT_ERRTYPE_ATTR_PRESENT 4 ; inline ! Non-allowed attribute present +: CRYPT_ERRTYPE_CONSTRAINT 5 ; inline ! Cert: Constraint violation in object +: CRYPT_ERRTYPE_ISSUERCONSTRAINT 6 ; inline ! Cert: Constraint viol.in issuing cert +: CRYPT_ERRTYPE_LAST 7 ; inline ! Last possible error info type + +! Cert store management action type +! CRYPT_CERTACTION_TYPE +: CRYPT_CERTACTION_NONE 0 ; inline ! No cert management action +: CRYPT_CERTACTION_CREATE 1 ; inline ! Create cert store +: CRYPT_CERTACTION_CONNECT 2 ; inline ! Connect to cert store +: CRYPT_CERTACTION_DISCONNECT 3 ; inline ! Disconnect from cert store +: CRYPT_CERTACTION_ERROR 4 ; inline ! Error information +: CRYPT_CERTACTION_ADDUSER 5 ; inline ! Add PKI user +: CRYPT_CERTACTION_DELETEUSER 6 ; inline ! Delete PKI user +: CRYPT_CERTACTION_REQUEST_CERT 7 ; inline ! Cert request +: CRYPT_CERTACTION_REQUEST_RENEWAL 8 ; inline ! Cert renewal request +: CRYPT_CERTACTION_REQUEST_REVOCATION 9 ; inline ! Cert revocation request +: CRYPT_CERTACTION_CERT_CREATION 10 ; inline ! Cert creation +: CRYPT_CERTACTION_CERT_CREATION_COMPLETE 11 ; inline ! Confirmation of cert creation +: CRYPT_CERTACTION_CERT_CREATION_DROP 12 ; inline ! Cancellation of cert creation +: CRYPT_CERTACTION_CERT_CREATION_REVERSE 13 ; inline ! Cancel of creation w.revocation +: CRYPT_CERTACTION_RESTART_CLEANUP 14 ; inline ! Delete reqs after restart +: CRYPT_CERTACTION_RESTART_REVOKE_CERT 15 ; inline ! Complete revocation after restart +: CRYPT_CERTACTION_ISSUE_CERT 16 ; inline ! Cert issue +: CRYPT_CERTACTION_ISSUE_CRL 17 ; inline ! CRL issue +: CRYPT_CERTACTION_REVOKE_CERT 18 ; inline ! Cert revocation +: CRYPT_CERTACTION_EXPIRE_CERT 19 ; inline ! Cert expiry +: CRYPT_CERTACTION_CLEANUP 20 ; inline ! Clean up on restart +: CRYPT_CERTACTION_LAST 21 ; inline ! Last possible cert store log action + +! =============================================== +! General Constants +! =============================================== + +! The maximum user key size - 2048 bits +: CRYPT_MAX_KEYSIZE 256 ; inline + +! The maximum IV size - 256 bits +: CRYPT_MAX_IVSIZE 32 ; inline + +! The maximum public-key component size - 4096 bits, and maximum component +! size for ECCs - 256 bits +: CRYPT_MAX_PKCSIZE 512 ; inline +: CRYPT_MAX_PKCSIZE_ECC 32 ; inline + +! The maximum hash size - 256 bits +: CRYPT_MAX_HASHSIZE 32 ; inline + +! The maximum size of a text string (e.g.key owner name) +: CRYPT_MAX_TEXTSIZE 64 ; inline + +! A magic value indicating that the default setting for this parameter +! should be used +: CRYPT_USE_DEFAULT -100 ; inline + +! A magic value for unused parameters +: CRYPT_UNUSED -101 ; inline + +! Cursor positioning codes for certificate/CRL extensions +: CRYPT_CURSOR_FIRST -200 ; inline +: CRYPT_CURSOR_PREVIOUS -201 ; inline +: CRYPT_CURSOR_NEXT -202 ; inline +: CRYPT_CURSOR_LAST -203 ; inline + +! The type of information polling to perform to get random seed +! information. These values have to be negative because they're used +! as magic length values for cryptAddRandom() +: CRYPT_RANDOM_FASTPOLL -300 ; inline +: CRYPT_RANDOM_SLOWPOLL -301 ; inline + +! Whether the PKC key is a public or private key +: CRYPT_KEYTYPE_PRIVATE 0 ; inline +: CRYPT_KEYTYPE_PUBLIC 1 ; inline + +! Keyset open options +! CRYPT_KEYOPT_TYPE +! (No options, Open keyset in read-only mode, Create a new keyset) +! Internal keyset options +! (As _NONE but open for exclusive access, _CRYPT_DEFINED +! Last possible key option type, _CRYPT_DEFINED Last external keyset option) +CONSTANT: CRYPT_KEYOPT_NONE 0 +CONSTANT: CRYPT_KEYOPT_READONLY 1 +CONSTANT: CRYPT_KEYOPT_CREATE 2 +CONSTANT: CRYPT_IKEYOPT_EXCLUSIVEACCESS 3 +CONSTANT: CRYPT_KEYOPT_LAST 4 + +: CRYPT_KEYOPT_LAST_EXTERNAL 3 ; inline ! = CRYPT_KEYOPT_CREATE + 1 + +TYPEDEF: int CRYPT_KEYOPT_TYPE + +! The various cryptlib objects - these are just integer handles +TYPEDEF: int CRYPT_CERTIFICATE +TYPEDEF: int CRYPT_CONTEXT +TYPEDEF: int CRYPT_DEVICE +TYPEDEF: int CRYPT_ENVELOPE +TYPEDEF: int CRYPT_KEYSET +TYPEDEF: int CRYPT_SESSION +TYPEDEF: int CRYPT_USER + +! Sometimes we don't know the exact type of a cryptlib object, so we use a +! generic handle type to identify it +TYPEDEF: int CRYPT_HANDLE + +! =============================================== +! Status Codes +! =============================================== + +! No error in function call +: CRYPT_OK 0 ; inline ! No error + +! Error in parameters passed to function +: CRYPT_ERROR_PARAM1 -1 ; inline ! Bad argument, parameter 1 +: CRYPT_ERROR_PARAM2 -2 ; inline ! Bad argument, parameter 2 +: CRYPT_ERROR_PARAM3 -3 ; inline ! Bad argument, parameter 3 +: CRYPT_ERROR_PARAM4 -4 ; inline ! Bad argument, parameter 4 +: CRYPT_ERROR_PARAM5 -5 ; inline ! Bad argument, parameter 5 +: CRYPT_ERROR_PARAM6 -6 ; inline ! Bad argument, parameter 6 +: CRYPT_ERROR_PARAM7 -7 ; inline ! Bad argument, parameter 7 + +! Errors due to insufficient resources +: CRYPT_ERROR_MEMORY -10 ; inline ! Out of memory +: CRYPT_ERROR_NOTINITED -11 ; inline ! Data has not been initialised +: CRYPT_ERROR_INITED -12 ; inline ! Data has already been init'd +: CRYPT_ERROR_NOSECURE -13 ; inline ! Opn.not avail.at requested sec.level +: CRYPT_ERROR_RANDOM -14 ; inline ! No reliable random data available +: CRYPT_ERROR_FAILED -15 ; inline ! Operation failed +: CRYPT_ERROR_INTERNAL -16 ; inline ! Internal consistency check failed + +! Security violations +: CRYPT_ERROR_NOTAVAIL -20 ; inline ! This type of opn.not available +: CRYPT_ERROR_PERMISSION -21 ; inline ! No permiss.to perform this operation +: CRYPT_ERROR_WRONGKEY -22 ; inline ! Incorrect key used to decrypt data +: CRYPT_ERROR_INCOMPLETE -23 ; inline ! Operation incomplete/still in progress +: CRYPT_ERROR_COMPLETE -24 ; inline ! Operation complete/can't continue +: CRYPT_ERROR_TIMEOUT -25 ; inline ! Operation timed out before completion +: CRYPT_ERROR_INVALID -26 ; inline ! Invalid/inconsistent information +: CRYPT_ERROR_SIGNALLED -27 ; inline ! Resource destroyed by extnl.event + +! High-level function errors +: CRYPT_ERROR_OVERFLOW -30 ; inline ! Resources/space exhausted +: CRYPT_ERROR_UNDERFLOW -31 ; inline ! Not enough data available +: CRYPT_ERROR_BADDATA -32 ; inline ! Bad/unrecognised data format +: CRYPT_ERROR_SIGNATURE -33 ; inline ! Signature/integrity check failed + +! Data access function errors +: CRYPT_ERROR_OPEN -40 ; inline ! Cannot open object +: CRYPT_ERROR_READ -41 ; inline ! Cannot read item from object +: CRYPT_ERROR_WRITE -42 ; inline ! Cannot write item to object +: CRYPT_ERROR_NOTFOUND -43 ; inline ! Requested item not found in object +: CRYPT_ERROR_DUPLICATE -44 ; inline ! Item already present in object + +! Data enveloping errors +: CRYPT_ENVELOPE_RESOURCE -50 ; inline ! Need resource to proceed + +! Error messages sequence +: error-messages ( -- seq ) { + { -1 "Bad argument, parameter 1" } + { -2 "Bad argument, parameter 2" } + { -3 "Bad argument, parameter 3" } + { -4 "Bad argument, parameter 4" } + { -5 "Bad argument, parameter 5" } + { -6 "Bad argument, parameter 6" } + { -7 "Bad argument, parameter 7" } + { -10 "Out of memory" } + { -11 "Data has not been initialised" } + { -12 "Data has already been init'd" } + { -13 "Opn.not avail.at requested sec.level" } + { -14 "No reliable random data available" } + { -15 "Operation failed" } + { -16 "Internal consistency check failed" } + { -20 "This type of opn.not available" } + { -21 "No permiss.to perform this operation" } + { -22 "Incorrect key used to decrypt data" } + { -23 "Operation incomplete/still in progress" } + { -24 "Operation complete/can't continue" } + { -25 "Operation timed out before completion" } + { -26 "Invalid/inconsistent information" } + { -27 "Resource destroyed by extnl.event" } + { -30 "Resources/space exhausted" } + { -31 "Not enough data available" } + { -32 "Bad/unrecognised data format" } + { -33 "Signature/integrity check failed" } + { -40 "Cannot open object" } + { -41 "Cannot read item from object" } + { -42 "Cannot write item to object" } + { -43 "Requested item not found in object" } + { -44 "Item already present in object" } + { -50 "Need resource to proceed" } +} ; + +LIBRARY: libcl + +! =============================================== +! cryptlib.h +! =============================================== + +! Initialise and shut down cryptlib +FUNCTION: C_RET cryptInit ( ) ; +FUNCTION: C_RET cryptEnd ( ) ; + +! Create and destroy an encryption context + +FUNCTION: C_RET cryptCreateContext ( CRYPT_CONTEXT* cryptContext, CRYPT_USER cryptUser, CRYPT_ALGO_TYPE cryptAlgo ) ; +FUNCTION: C_RET cryptDestroyContext ( CRYPT_CONTEXT cryptContext ) ; + +! Create/destroy an envelope +FUNCTION: C_RET cryptCreateEnvelope ( CRYPT_ENVELOPE* envelope, CRYPT_USER cryptUser, CRYPT_FORMAT_TYPE formatType ) ; +FUNCTION: C_RET cryptDestroyEnvelope ( CRYPT_ENVELOPE envelope ) ; + +! Add/remove data to/from and envelope or session +FUNCTION: C_RET cryptPushData ( CRYPT_HANDLE envelope, void* buffer, int length, int* bytesCopied ) ; +FUNCTION: C_RET cryptFlushData ( CRYPT_HANDLE envelope ) ; +FUNCTION: C_RET cryptPopData ( CRYPT_HANDLE envelope, void* buffer, int length, int* bytesCopied ) ; + +! Get/set/delete attribute functions +FUNCTION: C_RET cryptSetAttribute ( CRYPT_HANDLE cryptHandle, CRYPT_ATTRIBUTE_TYPE attributeType, int value ) ; +FUNCTION: C_RET cryptSetAttributeString ( CRYPT_HANDLE cryptHandle, CRYPT_ATTRIBUTE_TYPE attributeType, void* value, int valueLength ) ; + +! Generate a key into a context +FUNCTION: C_RET cryptGenerateKey ( CRYPT_CONTEXT cryptContext ) ; + +! Open and close a keyset +FUNCTION: C_RET cryptKeysetOpen ( CRYPT_KEYSET* keyset, CRYPT_USER cryptUser, CRYPT_KEYSET_TYPE keysetType, + char* name, CRYPT_KEYOPT_TYPE options ) ; +FUNCTION: C_RET cryptKeysetClose ( CRYPT_KEYSET keyset ) ; + +! Add/delete a key to/from a keyset or device +FUNCTION: C_RET cryptAddPublicKey ( CRYPT_KEYSET keyset, CRYPT_CERTIFICATE certificate ) ; +FUNCTION: C_RET cryptAddPrivateKey ( CRYPT_KEYSET keyset, CRYPT_HANDLE cryptKey, char* password ) ; +FUNCTION: C_RET cryptDeleteKey ( CRYPT_KEYSET keyset, CRYPT_KEYID_TYPE keyIDtype, char* keyID ) ; + +! Create/destroy a certificate +FUNCTION: C_RET cryptCreateCert ( CRYPT_CERTIFICATE* certificate, CRYPT_USER cryptUser, CRYPT_CERTTYPE_TYPE certType ) ; +FUNCTION: C_RET cryptDestroyCert ( CRYPT_CERTIFICATE certificate ) ; + +! Sign/sig.check a certificate/certification request +FUNCTION: C_RET cryptSignCert ( CRYPT_CERTIFICATE certificate, CRYPT_CONTEXT signContext ) ; +FUNCTION: C_RET cryptCheckCert ( CRYPT_CERTIFICATE certificate, CRYPT_HANDLE sigCheckKey ) ; + +! Import/export a certificate/certification request +FUNCTION: C_RET cryptImportCert ( void* certObject, int certObjectLength, CRYPT_USER cryptUser, CRYPT_CERTIFICATE* certificate ) ; +FUNCTION: C_RET cryptExportCert ( void* certObject, int certObjectMaxLength, int* certObjectLength, + CRYPT_CERTFORMAT_TYPE certFormatType, CRYPT_CERTIFICATE certificate ) ; + +! Get a key from a keyset or device +FUNCTION: C_RET cryptGetPublicKey ( CRYPT_KEYSET keyset, CRYPT_CONTEXT* cryptContext, CRYPT_KEYID_TYPE keyIDtype, char* keyID ) ; +FUNCTION: C_RET cryptGetPrivateKey ( CRYPT_KEYSET keyset, CRYPT_CONTEXT* cryptContext, CRYPT_KEYID_TYPE keyIDtype, char* keyID, char* password ) ; +FUNCTION: C_RET cryptGetKey ( CRYPT_KEYSET keyset, CRYPT_CONTEXT* cryptContext, CRYPT_KEYID_TYPE keyIDtype, char* keyID, char* password ) ; + +! Create/destroy a session +FUNCTION: C_RET cryptCreateSession ( CRYPT_SESSION* session, CRYPT_USER cryptUser, CRYPT_SESSION_TYPE formatType ) ; +FUNCTION: C_RET cryptDestroySession ( CRYPT_SESSION session ) ; diff --git a/cryptlib/notes.txt b/cryptlib/notes.txt new file mode 100644 index 0000000..b5f95cf --- /dev/null +++ b/cryptlib/notes.txt @@ -0,0 +1,51 @@ +Read remaining data: + + USING: alien libc kernel-internals byte-arrays ; + + SYMBOL: buffer + + 11 "uchar*" malloc-array buffer set + + "Hello world" buffer get string>memory + + buffer get 11 memory>string . + + "Hello world" + + 11 [ buffer get swap alien-unsigned-1 ] each + + .s + + 72 + 101 + 108 + 108 + 111 + 32 + 119 + 111 + 114 + 108 + 100 + + 11 [ buffer get swap alien-unsigned-1 ] map + + >byte-array . + + { 72 101 108 108 111 32 119 111 114 108 100 } + +Parse a file: + + openssl asn1parse -in file.pem + +Parse a DER file: + + openssl asn1parse -inform DER -in file.der + +Generate a PKCS#12 file: + + openssl pkcs12 -export -in certs.pem -out file.p12 -name "MY Certificate" + + The export option specifies that a PKCS#12 file will be generated (rather + than parsed). + diff --git a/cryptlib/streams/streams.factor b/cryptlib/streams/streams.factor new file mode 100644 index 0000000..929143f --- /dev/null +++ b/cryptlib/streams/streams.factor @@ -0,0 +1,157 @@ +! Copyright (C) 2007 Matthew Willis +! See http://factorcode.org/license.txt for BSD license. +USING: cryptlib cryptlib.libcl kernel alien sequences continuations +byte-arrays namespaces io.buffers math generic io strings +io.streams.lines io.streams.plain io.streams.duplex combinators +alien.c-types continuations ; + +IN: cryptlib.streams + +: set-attribute ( handle attribute value -- ) + cryptSetAttribute check-result ; + +: set-attribute-string ( handle attribute value -- ) + dup length swap string>char-alien swap + cryptSetAttributeString check-result ; + +: default-buffer-size 64 1024 * ; inline + +TUPLE: crypt-stream handle eof? ; + +: init-crypt-stream ( handle -- ) + dup CRYPT_OPTION_NET_READTIMEOUT 1 set-attribute + CRYPT_SESSINFO_ACTIVE 1 set-attribute ; + +: ( handle -- stream ) + dup init-crypt-stream + default-buffer-size + { set-crypt-stream-handle set-delegate } + crypt-stream construct + dup swap

; + +: check-read ( err -- eof? ) + { + { [ dup CRYPT_ERROR_READ = ] [ drop t ] } + { [ dup CRYPT_ERROR_COMPLETE = ] [ drop t ] } + { [ dup CRYPT_ERROR_TIMEOUT = ] [ drop f ] } + { [ t ] [ check-result f ] } + } cond ; + +: (refill) ( stream -- err ) + dup [ crypt-stream-handle ] keep [ buffer@ ] keep buffer-capacity + "int" dup >r cryptPopData r> *int rot buffer+ ; + +: refill ( stream -- ) + dup (refill) check-read swap set-crypt-stream-eof? ; + +: read-step ( n stream -- ) + dup refill tuck buffer-length 2dup <= + [ drop swap buffer> % ] + [ + - swap dup buffer>> % dup crypt-stream-eof? + [ 2drop ] [ read-step ] if + ] if ; + +M: crypt-stream stream-read ( n stream -- str/f ) + tuck buffer-length 2dup <= [ drop swap buffer> ] [ + pick buffer>> [ % - swap read-step ] "" make f like + ] if ; + +M: crypt-stream stream-read1 ( stream -- ch/f ) + 1 swap stream-read [ first ] [ f ] if* ; + +: read-until-step ( seps stream -- sep/f ) + dup refill 2dup buffer-read-until [ swap % 2nip ] + [ + % dup crypt-stream-eof? [ 2drop f ] [ read-until-step ] if + ] if* ; + +M: crypt-stream stream-read-until ( seps stream -- str/f sep/f ) + 2dup buffer-read-until [ >r 2nip r> ] [ + [ % read-until-step ] "" make f like swap + ] if* ; + +M: crypt-stream stream-flush ( cl-stream -- ) + crypt-stream-handle cryptFlushData check-result ; + +M: crypt-stream stream-write ( str stream -- ) + crypt-stream-handle over string>char-alien rot length + "int" cryptPushData check-result ; + +M: crypt-stream stream-write1 ( ch stream -- ) + >r 1string r> stream-write ; + +: check-close ( err -- ) + dup CRYPT_ERROR_PARAM1 = [ drop ] [ check-result ] if ; + +M: crypt-stream dispose ( stream -- ) + crypt-stream-handle cryptDestroySession check-close ; + +: create-session ( format -- session ) + "int" tuck CRYPT_UNUSED rot + cryptCreateSession check-result *int ; + +: crypt-client ( server port -- handle ) + CRYPT_SESSION_SSL create-session + [ CRYPT_SESSINFO_SERVER_PORT rot set-attribute ] keep + [ CRYPT_SESSINFO_SERVER_NAME rot set-attribute-string ] keep ; + +: crypt-server ( port -- handle ) + CRYPT_SESSION_SSL_SERVER create-session + [ CRYPT_SESSINFO_SERVER_PORT rot set-attribute ] keep ; + +: crypt-login ( handle user pass -- ) + swap pick CRYPT_SESSINFO_USERNAME rot set-attribute-string + CRYPT_SESSINFO_PASSWORD swap set-attribute-string ; + +: test-server ( -- stream ) + init + 8888 crypt-server + dup "user" "pass" crypt-login + + + "Welcome to cryptlib!" over stream-print + dup stream-flush + + dup stream-readln print + + dispose + end + ; + +: test-client ( -- stream ) + init + "localhost" 8888 crypt-client + dup "user" "pass" crypt-login + + + dup stream-readln print + + "Thanks!" over stream-print + dup stream-flush + + dispose + end + ; + +: (rpl) ( stream -- stream ) + readln + { + { [ dup "." = ] + [ drop dup stream-readln "READ: " write print flush (rpl) ] } + { [ dup "q" = ] [ drop ] } + { [ t ] [ over stream-print dup stream-flush (rpl) ] } + } cond ; + +: test-rpl ( client? -- ) + ! a server where you type responses to the client manually + init + [ "localhost" 8888 crypt-client ] [ 8888 crypt-server ] if + dup "user" "pass" crypt-login + + + (rpl) + + dispose + end + ; diff --git a/cryptlib/streams/tags.txt b/cryptlib/streams/tags.txt new file mode 100644 index 0000000..992ae12 --- /dev/null +++ b/cryptlib/streams/tags.txt @@ -0,0 +1 @@ +network diff --git a/cryptlib/summary.txt b/cryptlib/summary.txt new file mode 100644 index 0000000..8bc4f0e --- /dev/null +++ b/cryptlib/summary.txt @@ -0,0 +1 @@ +Cryptlib public-key encryption library binding diff --git a/cryptlib/tags.txt b/cryptlib/tags.txt new file mode 100644 index 0000000..b88f984 --- /dev/null +++ b/cryptlib/tags.txt @@ -0,0 +1,2 @@ +enterprise +bindings diff --git a/cryptlib/test/keys.p15 b/cryptlib/test/keys.p15 new file mode 100644 index 0000000..deacec6 Binary files /dev/null and b/cryptlib/test/keys.p15 differ diff --git a/cryptlib/test/large_data.txt b/cryptlib/test/large_data.txt new file mode 100644 index 0000000..03ce8bd --- /dev/null +++ b/cryptlib/test/large_data.txt @@ -0,0 +1,4928 @@ +/opt/local/lib/libcl.dylib(dylib1.o): +000007c4 t ___initialize_Cplusplus +000007a4 t __dyld_func_lookup + u __mh_dylib_header +0000079c t cfm_stub_binding_helper +000d8000 d dyld__mh_dylib_header +000dacbc s dyld_func_lookup_pointer +000dacb8 s dyld_lazy_symbol_binding_entry_point +0000076c t dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_add.o): +00000c48 T _BN_add +00000e54 T _BN_sub +00000ac8 T _BN_uadd + U _BN_ucmp +0000083c T _BN_usub + U _bn_add_words + U _bn_expand2 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_asm.o): + U _BN_num_bits_word +000017a8 T _bn_add_words +00001648 T _bn_div_words +000010a8 T _bn_mul_add_words +00002738 T _bn_mul_comba4 +000019c0 T _bn_mul_comba8 +000012fc T _bn_mul_words +000037b0 T _bn_sqr_comba4 +00002a90 T _bn_sqr_comba8 +00001560 T _bn_sqr_words +000018c8 T _bn_sub_words + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_ctx.o): +00003bfc T _BN_CTX_end +00003b08 T _BN_CTX_free +00003ba4 T _BN_CTX_get +00003ae0 T _BN_CTX_init +00003c4c T _BN_CTX_new +00003b7c T _BN_CTX_start + U _BN_clear_free + U _free + U _malloc + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_div.o): + U _BN_CTX_end + U _BN_CTX_get + U _BN_CTX_start + U _BN_add + U _BN_copy +00003c98 T _BN_div + U _BN_init + U _BN_lshift + U _BN_num_bits + U _BN_rshift + U _BN_set_word + U _BN_sub + U _BN_ucmp + U _BN_usub + U _bn_div_words + U _bn_expand2 + U _bn_mul_words + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_exp.o): + U _BN_CTX_end + U _BN_CTX_get + U _BN_CTX_start + U _BN_MONT_CTX_free + U _BN_MONT_CTX_new + U _BN_MONT_CTX_set + U _BN_RECP_CTX_free + U _BN_RECP_CTX_init + U _BN_RECP_CTX_set + U _BN_clear_free + U _BN_copy + U _BN_div +000041b4 T _BN_exp + U _BN_from_montgomery + U _BN_init + U _BN_is_bit_set +00004f6c T _BN_mod_exp +000046e8 T _BN_mod_exp_mont +00004b78 T _BN_mod_exp_mont_word +00004318 T _BN_mod_exp_recp +00004fec T _BN_mod_exp_simple + U _BN_mod_mul + U _BN_mod_mul_montgomery + U _BN_mod_mul_reciprocal + U _BN_mul + U _BN_mul_word + U _BN_nnmod + U _BN_num_bits + U _BN_set_word + U _BN_sqr + U _BN_ucmp + U _BN_value_one + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_exp2.o): + U _BN_CTX_end + U _BN_CTX_get + U _BN_CTX_start + U _BN_MONT_CTX_free + U _BN_MONT_CTX_new + U _BN_MONT_CTX_set + U _BN_clear_free + U _BN_div + U _BN_from_montgomery + U _BN_init + U _BN_is_bit_set +00005350 T _BN_mod_exp2_mont + U _BN_mod_mul_montgomery + U _BN_num_bits + U _BN_set_word + U _BN_ucmp + U _BN_value_one + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_gcd.o): + U _BN_CTX_end + U _BN_CTX_get + U _BN_CTX_start + U _BN_add + U _BN_cmp + U _BN_copy + U _BN_div + U _BN_free +00005b30 T _BN_gcd + U _BN_is_bit_set + U _BN_lshift + U _BN_lshift1 +00005d44 T _BN_mod_inverse + U _BN_mul + U _BN_mul_word + U _BN_new + U _BN_nnmod + U _BN_num_bits + U _BN_rshift + U _BN_rshift1 + U _BN_set_word + U _BN_sub + U _BN_uadd + U _BN_ucmp + U _BN_usub + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_lib.o): +000078d0 T _BN_bin2bn +00007128 T _BN_bn2bin +00006a0c T _BN_clear +00006be0 T _BN_clear_bit +00006614 T _BN_clear_free +00006af0 T _BN_cmp +000076fc T _BN_copy +00007350 T _BN_dup +000066b4 T _BN_free +00006498 T _BN_get_params +0000701c T _BN_get_word +00007250 T _BN_high_bit +00006730 T _BN_init +00006c84 T _BN_is_bit_set +00006ccc T _BN_mask_bits +0000674c T _BN_new +00006e30 T _BN_num_bits +00006584 T _BN_num_bits_word +0000651c T _BN_options +00007a60 T _BN_set_bit +000063d4 T _BN_set_params +00007834 T _BN_set_word +00006998 T _BN_swap +00006a5c T _BN_ucmp +00006500 T _BN_value_one +000c1b58 s _bits.2749 +00006ef0 T _bn_cmp_part_words +00006d8c T _bn_cmp_words +000074f8 T _bn_dup_expand +00006930 T _bn_expand2 +00006794 t _bn_expand_internal +000e5eec b _bn_limit_bits +000e5ee8 b _bn_limit_bits_high +000e5ee4 b _bn_limit_bits_low +000e5ee0 b _bn_limit_bits_mont +000d8010 d _bn_limit_num +000d800c d _bn_limit_num_high +000d8008 d _bn_limit_num_low +000d8004 d _bn_limit_num_mont +000d8014 d _const_one.2736 +000e5ef0 b _data.2742 +000d8028 d _data_one.2735 + U _free +000e5f00 b _init.2741 + U _malloc + U _memset + u _sprintf$LDBLStub + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_mod.o): + U _BN_CTX_end + U _BN_CTX_get + U _BN_CTX_start + U _BN_add + U _BN_cmp + U _BN_copy + U _BN_div + U _BN_dup + U _BN_free + U _BN_lshift + U _BN_lshift1 +00007e88 T _BN_mod_add +00007bdc T _BN_mod_add_quick +000081dc T _BN_mod_lshift +0000811c T _BN_mod_lshift1 +00007d24 T _BN_mod_lshift1_quick +00007d98 T _BN_mod_lshift_quick +00008008 T _BN_mod_mul +00007cbc T _BN_mod_sqr +00007f48 T _BN_mod_sub +00007c50 T _BN_mod_sub_quick + U _BN_mul +00007b2c T _BN_nnmod + U _BN_num_bits + U _BN_sqr + U _BN_sub + U _BN_ucmp + U _BN_usub + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_mont.o): + U _BN_CTX_end + U _BN_CTX_get + U _BN_CTX_start +00008a30 T _BN_MONT_CTX_copy +000087e0 T _BN_MONT_CTX_free +00008794 T _BN_MONT_CTX_init +00008abc T _BN_MONT_CTX_new +00008848 T _BN_MONT_CTX_set + U _BN_copy + U _BN_div + U _BN_free +00008384 T _BN_from_montgomery + U _BN_init + U _BN_lshift + U _BN_mod_inverse +000086dc T _BN_mod_mul_montgomery + U _BN_mul + U _BN_num_bits + U _BN_set_bit + U _BN_set_word + U _BN_sqr + U _BN_sub_word + U _BN_ucmp + U _BN_usub + U _bn_expand2 + U _bn_mul_add_words + U _free + U _malloc + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_mul.o): + U _BN_CTX_end + U _BN_CTX_get + U _BN_CTX_start + U _BN_copy +000090cc T _BN_mul + U _BN_num_bits_word + U _BN_set_word + U _bn_add_words + U _bn_cmp_words + U _bn_expand2 + U _bn_mul_add_words + U _bn_mul_comba4 + U _bn_mul_comba8 +0000938c T _bn_mul_high +00008b1c T _bn_mul_low_normal +00009bd0 T _bn_mul_low_recursive +00008bdc T _bn_mul_normal +000097f8 T _bn_mul_part_recursive +00008ce8 T _bn_mul_recursive + U _bn_mul_words + U _bn_sub_words + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_recp.o): + U _BN_CTX_end + U _BN_CTX_get + U _BN_CTX_start +00009e44 T _BN_RECP_CTX_free +00009e04 T _BN_RECP_CTX_init +00009fa0 T _BN_RECP_CTX_new +00009ea0 T _BN_RECP_CTX_set + U _BN_add_word + U _BN_copy + U _BN_div +00009ff4 T _BN_div_recp + U _BN_free + U _BN_init +0000a2d4 T _BN_mod_mul_reciprocal + U _BN_mul + U _BN_num_bits +00009f04 T _BN_reciprocal + U _BN_rshift + U _BN_set_bit + U _BN_set_word + U _BN_sqr + U _BN_ucmp + U _BN_usub + U _free + U _malloc + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_shift.o): +0000a5dc T _BN_lshift +0000a3a0 T _BN_lshift1 +0000a76c T _BN_rshift +0000a498 T _BN_rshift1 + U _BN_set_word + U _bn_expand2 + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_sqr.o): + U _BN_CTX_end + U _BN_CTX_get + U _BN_CTX_start + U _BN_copy + U _BN_num_bits_word +0000acd8 T _BN_sqr + U _bn_add_words + U _bn_cmp_words + U _bn_expand2 + U _bn_mul_add_words + U _bn_mul_words + U _bn_sqr_comba4 + U _bn_sqr_comba8 +0000a910 T _bn_sqr_normal +0000aa1c T _bn_sqr_recursive + U _bn_sqr_words + U _bn_sub_words + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bn_word.o): +0000b3e8 T _BN_add_word +0000b0d8 T _BN_div_word +0000b050 T _BN_mod_word +0000b198 T _BN_mul_word + U _BN_set_word +0000b238 T _BN_sub_word + u ___umoddi3 + U _bn_div_words + U _bn_expand2 + U _bn_mul_words + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certcget.o): + U _addAttributeField + U _certWriteTable + U _deleteAttribute + U _deleteAttributeField +0000c088 T _deleteCertComponent + U _deleteDN + U _deleteDNComponent + U _encodePKIUserValue + U _findAttribute + U _findAttributeField + U _findAttributeFieldEx +0000b760 t _getCertAttributeComponent +0000c660 T _getCertComponent + U _getDNComponentValue + U _getDefaultFieldValue + U _getHashParameters + U _krnlSendMessage + U _memcmp + U _memcpy + U _memset +0000b5e4 T _moveCursorToField +0000b4e8 T _oidToText + U _sMemClose + U _sMemDisconnect + U _sMemOpen +0000be0c T _selectDN +0000ba64 T _selectGeneralName + U _sizeofObject + u _sprintf$LDBLStub + U _strlen + U _swrite +0000b910 T _syncSelection +000d7f38 s _value.5917 + U _writeConstructed + U _writeDNstring + U _writeInteger + U _writeOctetString + U _writeSequence + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certchk.o): +000c1c64 s _certTypeInfo + U _checkAttributePresent +0000ec8c T _checkCert +0000d4bc T _checkCertUsage +0000e678 T _checkNameConstraints +0000d40c T _checkPolicyConstraints + U _compareDN +000c1cac s _extendedUsageInfo + U _findAttributeField +0000d774 T _getKeyUsageFromExtKeyUsage + U _getTime + U _krnlSendMessage + U _memcmp +0000ddd4 t _wildcardStringMatch + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certchn.o): +00010ec4 T _assembleCertChain +00010a0c t _buildCertChain +00010020 t _buildCertChainInfo + U _checkAttributePresent + U _checkCert +0001013c T _checkCertChain + U _checkEOC + U _checkNameConstraints + U _checkPolicyConstraints + U _checkX509signature + U _compareSerialNumber +00010700 T _copyCertChain + U _findAttribute + U _findAttributeField + U _importCert + U _krnlGetObject + U _krnlReleaseObject + U _krnlSendMessage + U _memcmp + U _memcpy + U _memset +0001106c T _readCertChain + U _readConstructed + U _readConstructedI + U _readGenericHole + U _readRawObjectTag + U _readSequence + U _readSequenceI + U _readSet + U _readShortIntegerTag + U _readUniversal + U _sMemConnect + U _sMemDisconnect +00011698 T _sizeofCertSet + U _sizeofObject +0000fde4 t _sortCertChain + U _sseek + U _swrite +000113c0 T _writeCertChain +000118ac T _writeCertSequence +00011740 T _writeCertSet + U _writeConstructed + U _writeSequence + U _writeSet + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certcset.o): + U _addAttributeField +00011da0 T _addCertComponent + U _addRevocationEntry + U _addValidityEntry + U _compareDN + U _copyAttributes + U _copyCertChain + U _copyDN +00011bc4 t _copyPublicKeyInfo + U _copyRequestAttributes + U _copyRevocationAttributes + U _copyRevocationEntries + U _copyValidityEntries + U _deleteCertComponent + U _deleteDN + U _findAttribute + U _findAttributeField + U _findAttributeFieldEx + U _free + U _getApproxTime + U _getCertComponent + U _getDNComponentValue + U _getHashParameters + U _insertDNComponent + U _krnlGetObject + U _krnlReleaseObject + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _messageValueTrue + U _moveAttributeCursor + U _moveCursorToField + U _readBitStringHole + U _readCRLentry + U _readDNstring + U _readSequence + U _readUniversal + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _selectDN + U _selectGeneralName +00011a14 T _setSerialNumber +00013788 t _setXyzzyInfo + U _sizeofAlgoID + U _sizeofDN + U _sizeofObject + U _syncSelection + U _writeAlgoID + U _writeDN + U _writeInteger + U _writeOctetString + U _writeSequence + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certdn.o): + U ___toupper + U _addCertComponent +000db844 s _certInfoOIDs +00014618 T _checkDN +00013d20 T _compareDN +00014450 T _convertEmail +00014df0 T _copyDN + U _copyFromAsn1String + U _copyToAsn1String +000c1d3c s _countryCodes.5570 +00015038 T _deleteDN +00014f20 T _deleteDNComponent +000d802c d _dnSortTable + U _free +00013c80 T _getDNComponentValue +00013c74 T _insertDNComponent +000138e0 t _insertDNstring + U _malloc + U _memcmp + U _memcpy + U _memset + U _readBitStringHole +00013df4 T _readDN +00014710 T _readDNstring + U _readGenericHole + U _readRawObjectTag + U _readSequence + U _readSet + U _readUniversal + U _sPeek +000150dc T _sizeofDN + U _sizeofObject + U _sputc + U _sseek + U _strlen + U _strncasecmp + U _swrite + U _writeCharacterString + U _writeConstructed +000140f0 T _writeDN +000142bc T _writeDNstring + U _writeSequence + U _writeSet + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certechk.o): +00015320 t _checkAttribute +00015888 T _checkAttributes + U _memset + U _selectAttributeInfo + U _sizeofObject +000151d0 t _updateStackedInfo + U _writeAttributeField + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certedef.o): + U __DefaultRuneLocale + U ___maskrune + U _checkDN +00015dc0 t _checkDNS +00015a60 t _checkDirectoryName +00015dd0 t _checkHTTP +00015db0 t _checkRFC822 +00015da0 t _checkURL +00015ab8 t _checkURLString +000ddcc0 s _cmsAttributeInfo +000dea64 s _contentTypeInfo +000dbdf4 s _extensionInfo +000dda38 s _generalNameInfo +000dd984 s _holdInstructionInfo +00015a30 T _selectAttributeInfo + U _strncasecmp + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certexrd.o): + U _addAttribute + U _addAttributeField + U _deleteDN +000d7f38 s _dummy.5586 + U _krnlSendMessage + U _memcmp + U _oidToAttribute +0001638c t _readAttribute +00015fd4 t _readAttributeField +00016c24 T _readAttributes + U _readBitStringTag + U _readBooleanTag + U _readConstructed + U _readDN + U _readEnumeratedTag + U _readGeneralizedTimeTag +00015de0 t _readIdentifierFields + U _readOctetStringHole + U _readOctetStringTag + U _readRawObjectTag + U _readSequence + U _readSet + U _readShortIntegerTag + U _readUTCTimeTag + U _readUniversal + U _sPeek + U _sgetc + U _sseek + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certext.o): + U __DefaultRuneLocale +00017bdc T _addAttribute +00018598 T _addAttributeField +00017dcc T _checkAttributePresent + U _checkTextStringData +000c1ddc s _completeAttribute.5704 + U _convertEmail +00017e0c t _copyAttribute +00018e1c T _copyAttributes + U _copyDN +00019134 T _copyIssuerAttributes +0001952c T _copyRequestAttributes +00018144 T _copyRevocationAttributes +000c1e70 s _defaultField.5703 +00018240 T _deleteAttribute +000176f4 T _deleteAttributeField +000184d8 T _deleteAttributes + U _deleteDN +00017248 t _fieldIDToAttribute +00017604 T _findAttribute +00017394 T _findAttributeByOID +0001741c T _findAttributeField +000174cc T _findAttributeFieldEx +00018c1c T _fixAttributes + U _free +000176b8 T _getDefaultFieldValue + U _getObjectLength + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _memset +000177f0 T _moveAttributeCursor +000171b8 T _oidToAttribute + U _selectAttributeInfo + U _textToOID + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certexwr.o): +00019658 t _getNextEncodedAttribute + U _krnlSendMessage + U _memcmp + U _memcpy + U _memset + U _sMemDisconnect + U _sMemOpen +00019870 T _sizeofAttributes + U _sizeofDN + U _sizeofObject + U _sputc + U _sseek + U _swrite +0001a0c4 t _writeAttribute +000199dc T _writeAttributeField +0001a348 T _writeAttributes + U _writeBitString + U _writeBoolean + U _writeCharacterString + U _writeConstructed + U _writeDN + U _writeEnumerated + U _writeGeneralizedTime + U _writeInteger + U _writeNull + U _writeOctetString + U _writeOctetStringHole + U _writeSequence + U _writeSet + U _writeShortInteger + U _writeUTCTime + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certio.o): + U _base64checkHeader + U _base64decode + U _base64decodeLen + U _base64encode + U _base64encodeLen + U _certReadTable + U _checkEOC + U _checkObjectEncoding + U _createCertificateInfo +0001b414 T _exportCert + U _free + U _getLongObjectLength + U _getObjectLength +0001a650 T _importCert + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _messageValueCryptOK + U _messageValueCryptUnused + U _readCertChain + U _readConstructed + U _readConstructedI + U _readLongSequence + U _readOID + U _readOctetStringHole + U _readRawObjectTag + U _readSequence + U _readSequenceI + U _readSet + U _readShortIntegerTag + U _readUniversal + U _sMemClose + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _sPeek + U _sgetc + U _sizeofCertSet + U _sizeofObject + U _sseek + U _writeCertChain + U _writeCertSequence + U _writeCertSet + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certrd.o): +000dec38 S _certReadTable + U _fixAttributes + U _getStreamObjectLength + U _iCryptReadSubjectPublicKey + U _krnlSendMessage + U _malloc + U _memcmp + U _memset + U _readAlgoID +0001c4bc t _readAttributeCertInfo + U _readAttributes + U _readBitStringHole +0001cac8 t _readCRLInfo + U _readCRLentry +0001ce00 t _readCertInfo +0001d2b4 t _readCertRequestInfo +0001b674 t _readCmsAttributes + U _readConstructed + U _readContextAlgoID +0001b9f8 t _readCrmfRequestInfo + U _readDN + U _readGeneralizedTimeTag + U _readGenericHole + U _readIntegerTag + U _readLongSequence + U _readOcspRequestEntry +0001c09c t _readOcspRequestInfo + U _readOcspResponseEntry +0001c25c t _readOcspResponseInfo + U _readOctetStringTag +0001b690 t _readPkiUserInfo +0001c818 t _readRevRequestInfo + U _readRtcsRequestEntry +0001be10 t _readRtcsRequestInfo + U _readRtcsResponseEntry +0001bf68 t _readRtcsResponseInfo + U _readSequence + U _readShortIntegerTag + U _readUTCTimeTag + U _readUniversal +0001b908 t _readValidity + U _sMemConnect + U _sMemDisconnect + U _sPeek + U _setSerialNumber + U _sread + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certrev.o): + U _addAttributeField +0001d4c0 T _addRevocationEntry +0001e19c T _checkRevocation + U _checksumData +0001d6e0 T _copyRevocationEntries + U _deleteAttributes +0001d644 T _deleteRevocationEntries + U _findAttributeField + U _free + U _getCertComponent + U _getHashParameters + U _getStreamObjectLength + U _malloc + U _memcmp + U _memcpy + U _memset + U _readAttributes +0001d824 T _readCRLentry + U _readConstructed + U _readEnumeratedTag + U _readGeneralizedTimeTag + U _readIntegerTag +0001d9f4 t _readOcspID +0001dbe4 T _readOcspRequestEntry +0001dcdc T _readOcspResponseEntry + U _readSequence + U _readUTCTimeTag + U _readUniversal + U _sPeek + U _sizeofAttributes +0001d7b8 T _sizeofCRLentry + U _sizeofObject +0001e038 T _sizeofOcspRequestEntry +0001e088 T _sizeofOcspResponseEntry + U _sread + U _sseek + U _swrite + U _writeAttributes +0001d92c T _writeCRLentry + U _writeConstructed + U _writeGeneralizedTime + U _writeInteger + U _writeNull +0001e104 T _writeOcspRequestEntry +0001df34 T _writeOcspResponseEntry + U _writeSequence + U _writeUTCTime + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certsig.o): + U _certWriteTable + U _checkCert + U _checkCertChain + U _checkCertUsage +0001f374 T _checkCertValidity +0001f1e0 T _checkOCSPResponse +0001f124 T _checkRTCSResponse + U _checkRevocation + U _checkX509signature + U _copyCertChain + U _copyRevocationAttributes + U _createX509signature + U _exportCert + U _exportCertToStream + U _free + U _getHashParameters + U _getReliableTime + U _getTime + U _iCryptReadSubjectPublicKey + U _krnlGetObject + U _krnlReleaseObject + U _krnlSendMessage + U _malloc + U _memcpy + U _memset + U _messageValueCryptUnused + U _messageValueTrue + U _readConstructed + U _readSequence + U _readUniversal +0001e318 t _recoverCertData + U _sMemClose + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _sPeek + U _setSerialNumber +0001e600 T _signCert + U _sizeofObject + U _sseek + U _swrite + U _writeConstructed + U _writeInteger + U _writeSequence + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certstr.o): + U __DefaultRuneLocale + U ___maskrune +000c1f04 s _asn1CharFlags +000c2184 s _charMap.5789 +0001fd48 T _checkTextStringData +000200bc T _copyFromAsn1String +0001fe28 T _copyToAsn1String + U _memcpy + U _memmove +000c2104 s _utf8bytesTbl + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certrust.o): +00020c9c t _addEntry +000212e0 T _addTrustEntry + U _checksumData +000206e8 T _deleteTrustEntry + U _dynCreate + U _dynDestroy +00020a50 T _endTrustInfo +000208a0 T _enumTrustedCerts +00020b60 T _findTrustEntry + U _free + U _getHashParameters +0002079c T _getTrustedCert +000e5f04 b _hashFunction.5424 +0002084c T _initTrustInfo + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _memset + U _messageValueCursorFirst + U _messageValueCursorNext + U _messageValueFalse + U _messageValueTrue + U _readConstructed + U _readSequence + U _readUniversal + U _sMemConnect + U _sMemDisconnect + U _sPeek + U _sizeofObject + U _sseek + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certval.o): +00021500 T _addValidityEntry +000218e0 T _checkValidity + U _checksumData +00021670 T _copyValidityEntries + U _deleteAttributes +000215f8 T _deleteValidityEntries + U _free + U _getCertComponent + U _malloc + U _memcmp + U _memcpy + U _memset + U _readAttributes + U _readBooleanTag + U _readConstructed + U _readEnumeratedTag + U _readOctetStringTag +00021984 T _readRtcsRequestEntry +00021b10 T _readRtcsResponseEntry + U _readSequence + U _readUniversal + U _sizeofAttributes + U _sizeofObject +00021710 T _sizeofRtcsRequestEntry +0002178c T _sizeofRtcsResponseEntry + U _writeAttributes + U _writeBoolean + U _writeEnumerated + U _writeOctetString +0002173c T _writeRtcsRequestEntry +000217f8 T _writeRtcsResponseEntry + U _writeSequence + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(certwr.o): + U _addAttributeField + U _addCertComponent + U _adjustPKIUserValue +000decb0 S _certWriteTable + U _checkAttributePresent + U _checkAttributes + U _checkCert + U _checkDN + U _compareDN + U _copyDN + U _copyIssuerAttributes + U _findAttributeField + U _getApproxTime + U _getKeyUsageFromExtKeyUsage + U _getTime + U _krnlSendMessage +00021d14 t _preEncodeCertificate + U _sMemDisconnect + U _sMemOpen + U _sizeofAttributes + U _sizeofCRLentry + U _sizeofContextAlgoID + U _sizeofDN + U _sizeofObject + U _sizeofOcspRequestEntry + U _sizeofOcspResponseEntry + U _sizeofRtcsRequestEntry + U _sizeofRtcsResponseEntry + U _swrite +000224d0 t _writeAttributeCertInfo + U _writeAttributes +00022c50 t _writeCRLInfo + U _writeCRLentry +00022290 t _writeCertInfo +000226e4 t _writeCertRequestInfo +00022ea0 t _writeCmsAttributes + U _writeConstructed + U _writeContextAlgoID +00022884 t _writeCrmfRequestInfo + U _writeDN + U _writeGeneralizedTime + U _writeInteger + U _writeOcspRequestEntry +00023368 t _writeOcspRequestInfo + U _writeOcspResponseEntry +00023674 t _writeOcspResponseInfo + U _writeOctetString +00023868 T _writePkiUserInfo +00022b04 t _writeRevRequestInfo + U _writeRtcsRequestEntry +00023010 t _writeRtcsRequestInfo + U _writeRtcsResponseEntry +00023210 t _writeRtcsResponseInfo + U _writeSequence + U _writeShortInteger + U _writeUTCTime + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(aescrypt.o): +00024c44 T _aes_decrypt +00023bf8 T _aes_encrypt + U _t_fl + U _t_fn + U _t_il + U _t_in + +/opt/local/lib/libcl.dylib(aeskey.o): +00028934 T _aes_decrypt_key +00026c8c T _aes_decrypt_key128 +00027424 T _aes_decrypt_key192 +00027cc4 T _aes_decrypt_key256 +00026c34 T _aes_encrypt_key +00025c78 T _aes_encrypt_key128 +0002612c T _aes_encrypt_key192 +000265f4 T _aes_encrypt_key256 + U _t_fl + U _t_im + U _t_rc + +/opt/local/lib/libcl.dylib(aestab.o): +0002898c T _gen_tabs +000c51bc S _t_fl +000c61bc S _t_fn +000c31bc S _t_il +000c21bc S _t_im +000c41bc S _t_in +000c71bc S _t_rc + +/opt/local/lib/libcl.dylib(bfecb.o): + U _BF_decrypt +000289ac T _BF_ecb_encrypt + U _BF_encrypt +00028990 T _BF_options + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(bfenc.o): +0002935c T _BF_cbc_encrypt +00028ef4 T _BF_decrypt +00028a8c T _BF_encrypt + +/opt/local/lib/libcl.dylib(bfskey.o): + U _BF_encrypt +000298ec T _BF_set_key +000c71e4 s _bf_init + U _memcpy + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(castecb.o): + U _CAST_decrypt +00029a3c T _CAST_ecb_encrypt + U _CAST_encrypt + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(castenc.o): + U _CAST_S_table0 + U _CAST_S_table1 + U _CAST_S_table2 + U _CAST_S_table3 +0002a400 T _CAST_cbc_encrypt +00029f78 T _CAST_decrypt +00029b1c T _CAST_encrypt + +/opt/local/lib/libcl.dylib(castskey.o): +000c9e2c S _CAST_S_table0 +000c9a2c S _CAST_S_table1 +000c962c S _CAST_S_table2 +000c922c S _CAST_S_table3 +000c8e2c S _CAST_S_table4 +000c8a2c S _CAST_S_table5 +000c862c S _CAST_S_table6 +000c822c S _CAST_S_table7 +0002a990 T _CAST_set_key + +/opt/local/lib/libcl.dylib(descbc.o): + U _des_encrypt1 +0002b598 T _des_ncbc_encrypt + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(desecb.o): +000e5f08 b _buf.2415 +000ca22c S _des_SPtrans +0002bbec T _des_ecb_encrypt + U _des_encrypt1 +0002bb6c T _des_options +000d8044 d _init.2414 + u _sprintf$LDBLStub + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(desecb3.o): + U _des_decrypt3 +0002bcbc T _des_ecb3_encrypt + U _des_encrypt3 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(desenc.o): + U _des_SPtrans +0002e41c T _des_decrypt3 +0002e5a8 T _des_ede3_cbc_encrypt +0002bda4 T _des_encrypt1 +0002d0b4 T _des_encrypt2 +0002e294 T _des_encrypt3 +000d804c D _version1 +000d8048 D _version2 + +/opt/local/lib/libcl.dylib(desskey.o): +000d8050 D _des_check_key +0002ec04 T _des_check_key_parity +0002ef5c T _des_fixup_key_parity +0002ec6c T _des_is_weak_key +0002f068 T _des_key_sched +0002f144 T _des_set_key +0002ef98 T _des_set_key_checked +0002ecd8 T _des_set_key_unchecked +0002ebc8 T _des_set_odd_parity +000caa2c s _des_skb + U _memcmp +000cb22c s _odd_parity +000d80d4 d _shifts2.2471 +000d8054 d _weak_keys + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(icbc.o): +0002fad4 T _idea_cbc_encrypt +0002f220 T _idea_encrypt + +/opt/local/lib/libcl.dylib(iecb.o): +00030080 T _idea_ecb_encrypt + U _idea_encrypt +00030064 T _idea_options + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(iskey.o): +00030334 T _idea_set_decrypt_key +0003014c T _idea_set_encrypt_key + +/opt/local/lib/libcl.dylib(rc2cbc.o): +0003076c T _RC2_cbc_encrypt +000305f4 T _RC2_decrypt +0003049c T _RC2_encrypt + +/opt/local/lib/libcl.dylib(rc2ecb.o): + U _RC2_decrypt +00030cfc T _RC2_ecb_encrypt + U _RC2_encrypt + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(rc2skey.o): +00030ddc T _RC2_set_key +000d8114 d _key_table + +/opt/local/lib/libcl.dylib(rc4enc.o): +00030f24 T _RC4 +000cb32c s _is_endian.1921 + +/opt/local/lib/libcl.dylib(rc4skey.o): +00031968 T _RC4_options +00031984 T _RC4_set_key + +/opt/local/lib/libcl.dylib(rc5ecb.o): + U _RC5_32_decrypt +00031a90 T _RC5_32_ecb_encrypt + U _RC5_32_encrypt + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(rc5enc.o): +00032530 T _RC5_32_cbc_encrypt +000320b4 T _RC5_32_decrypt +00031b70 T _RC5_32_encrypt + +/opt/local/lib/libcl.dylib(rc5skey.o): +00032ac0 T _RC5_32_set_key + +/opt/local/lib/libcl.dylib(skipjack.o): +000cb330 s _fTable +00033680 T _skipjackDecrypt +00032dec T _skipjackEncrypt +00032d94 T _skipjackMakeKey + +/opt/local/lib/libcl.dylib(dev_fort.o): + +/opt/local/lib/libcl.dylib(dev_pk11.o): + +/opt/local/lib/libcl.dylib(dev_sys.o): +00033f30 T _addRandomData +00034654 T _addRandomLong + U _aesDecryptCBC + U _aesDecryptCFB + U _aesDecryptECB + U _aesDecryptOFB + U _aesEncryptCBC + U _aesEncryptCFB + U _aesEncryptECB + U _aesEncryptOFB + U _aesGetInfo + U _aesInitKey + U _aesSelfTest + U _blowfishDecryptCBC + U _blowfishDecryptCFB + U _blowfishDecryptECB + U _blowfishDecryptOFB + U _blowfishEncryptCBC + U _blowfishEncryptCFB + U _blowfishEncryptECB + U _blowfishEncryptOFB + U _blowfishGetInfo + U _blowfishInitKey + U _blowfishSelfTest +000d8214 d _capabilities + U _castDecryptCBC + U _castDecryptCFB + U _castDecryptECB + U _castDecryptOFB + U _castEncryptCBC + U _castEncryptCFB + U _castEncryptECB + U _castEncryptOFB + U _castGetInfo + U _castInitKey + U _castSelfTest + U _checkForked +00034780 t _controlFunction + U _createCertificate + U _createContext + U _createDevice + U _createEnvelope + U _createKeyset +000dee28 s _createObjectFunctions + U _createSession + U _createUser +00034358 T _cryptAddRandom + U _deriveCMP + U _derivePGP + U _derivePKCS5 + U _deriveSSL + U _deriveTLS + U _des3DecryptCBC + U _des3DecryptCFB + U _des3DecryptECB + U _des3DecryptOFB + U _des3EncryptCBC + U _des3EncryptCFB + U _des3EncryptECB + U _des3EncryptOFB + U _des3GetInfo + U _des3InitKey + U _des3SelfTest +0003428c t _des3TestLoop + U _desDecryptCBC + U _desDecryptCFB + U _desDecryptECB + U _desDecryptOFB + U _desEncryptCBC + U _desEncryptCFB + U _desEncryptECB + U _desEncryptOFB + U _desGetInfo + U _desInitKey + U _desSelfTest + U _des_ecb3_encrypt + U _des_key_sched + U _des_set_key_unchecked + U _des_set_odd_parity + U _dhDecrypt + U _dhEncrypt + U _dhGenerateKey + U _dhInitKey + U _dhSelfTest + U _dsaGenerateKey + U _dsaInitKey + U _dsaSelfTest + U _dsaSigCheck + U _dsaSign + U _elgamalDecrypt + U _elgamalEncrypt + U _elgamalGenerateKey + U _elgamalInitKey + U _elgamalSelfTest +00034058 T _endRandomData + U _exportCMS + U _exportPKCS1 + U _exportPKCS1PGP + U _exportPrivateKey + U _exportPrivateKeyPKCS8 + U _fastPoll +00034128 t _generateX917 + U _getHashParameters + U _getInfo +00034b14 t _getRandomFunction + U _getTime +000dee68 s _hashData.5201 +000e5f2c b _hashFunction.5408 +000e5f28 b _hashSize.5409 + U _hmacMD5GetInfo + U _hmacMD5Hash + U _hmacMD5InitKey + U _hmacMD5SelfTest + U _hmacRIPEMD160GetInfo + U _hmacRIPEMD160Hash + U _hmacRIPEMD160InitKey + U _hmacRIPEMD160SelfTest + U _hmacSHAGetInfo + U _hmacSHAHash + U _hmacSHAInitKey + U _hmacSHASelfTest + U _ideaDecryptCBC + U _ideaDecryptCFB + U _ideaDecryptECB + U _ideaDecryptOFB + U _ideaEncryptCBC + U _ideaEncryptCFB + U _ideaEncryptECB + U _ideaEncryptOFB + U _ideaGetInfo + U _ideaInitKey + U _ideaSelfTest + U _importCMS + U _importPKCS1 + U _importPKCS1PGP + U _importPrivateKey + U _importPrivateKeyOpenPGP + U _importPrivateKeyPGP + U _importPrivateKeyPKCS8 +00034458 t _initFunction + U _initKeyParams +00033f18 T _initRandomData + U _initRandomPolling + U _krnlMemalloc + U _krnlMemfree + U _krnlSendMessage + U _md2GetInfo + U _md2Hash + U _md2SelfTest + U _md4GetInfo + U _md4Hash + U _md4SelfTest + U _md5GetInfo + U _md5Hash + U _md5SelfTest +000ded20 s _mechanismFunctions + U _memcmp + U _memcpy + U _memset +000e5f30 b _nonceData.5407 +000e5f58 b _nonceDataInitialised.5406 + U _rc2DecryptCBC + U _rc2DecryptCFB + U _rc2DecryptECB + U _rc2DecryptOFB + U _rc2EncryptCBC + U _rc2EncryptCFB + U _rc2EncryptECB + U _rc2EncryptOFB + U _rc2GetInfo + U _rc2InitKey + U _rc2SelfTest + U _rc4Encrypt + U _rc4GetInfo + U _rc4InitKey + U _rc4SelfTest + U _rc5DecryptCBC + U _rc5DecryptCFB + U _rc5DecryptECB + U _rc5DecryptOFB + U _rc5EncryptCBC + U _rc5EncryptCFB + U _rc5EncryptECB + U _rc5EncryptOFB + U _rc5GetInfo + U _rc5InitKey + U _rc5SelfTest + U _ripemd160GetInfo + U _ripemd160Hash + U _ripemd160SelfTest + U _rsaDecrypt + U _rsaEncrypt + U _rsaGenerateKey + U _rsaInitKey + U _rsaSelfTest +000343ec T _setDeviceSystem + U _shaGetInfo + U _shaHash + U _shaSelfTest +00034610 t _shutdownFunction + U _sigcheckPKCS1 + U _signPKCS1 + U _skipjackDecryptCBC + U _skipjackDecryptCFB + U _skipjackDecryptECB + U _skipjackDecryptOFB + U _skipjackEncryptCBC + U _skipjackEncryptCFB + U _skipjackEncryptECB + U _skipjackEncryptOFB + U _skipjackGetInfo + U _skipjackInitKey + U _skipjackSelfTest + U _slowPoll +000cb5f8 s _testDP +000cc438 s _testIP +000cb8f8 s _testKP +000cb430 s _testSB +000cbe38 s _testVP + U _waitforRandomCompletion + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(denv_cms.o): + U _addAction +000355e4 t _addContentListItem + U _appendContentListItem + U _checkEOC + U _createContentListItem +000def6c s _envelopeOIDselection + U _free + U _getStreamObjectLength + U _inflateInit_ +00036420 T _initCMSDeenveloping + U _initEnvelopeEncryption + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _memmove +000deebc s _nestedContentOIDselection +00035f4c t _processPostamble +000358b4 t _processPreamble + U _queryAsn1Object + U _readCMSencrHeader + U _readCMSheader + U _readConstructed + U _readContextAlgoID + U _readRawObjectTag + U _readSetI + U _sMemConnect + U _sMemDisconnect + U _sPeek + U _sread + U _sseek + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(denv_pgp.o): + U _addAction +00036454 t _addContentListItem + U _appendContentListItem + U _createContentListItem + U _deleteContentList + U _free + U _inflateInit2_ + U _inflateInit_ +00036a7c T _initPGPDeenveloping + U _krnlSendMessage + U _malloc + U _memcpy + U _memmove + U _pgpProcessIV + U _pgpReadPacketHeader +0003682c t _processPostamble +00036ab0 t _processPreamble + U _queryPgpObject + U _sMemClose + U _sMemConnect + U _sMemDisconnect + U _sgetc + U _sread + U _sseek +000cca4c s _typeMapTbl.5403 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(env_cms.o): + U _addAction + U _checkAlgoID +00037458 t _checkCryptAlgo +0003748c t _checkHashAlgo +000df02c s _contentOIDs + U _deleteUnusedActions +00038660 t _emitPostamble +000377a0 t _emitPreamble + U _exportCertToStream + U _findAction + U _iCryptCreateSignatureEx + U _iCryptExportKeyEx +000cca8c s _indefEOC.5447 +000374c4 T _initCMSEnveloping + U _initEnvelopeEncryption + U _krnlSendMessage + U _malloc + U _memcpy + U _memmove + U _sMemDisconnect + U _sMemOpen + U _sizeofCMSencrHeader + U _sizeofContextAlgoID + U _sizeofObject + U _swrite + U _writeCMSencrHeader + U _writeCMSheader + U _writeContextAlgoID + U _writeSet + U _writeShortInteger +000375cc t _writeSignedDataHeader + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(env_dec.o): + U _checkEOC +00038bdc t _copyFromDeenvelope +0003913c t _copyToDeenvelope + U _inflate +000390f8 T _initDeenvelopeStreaming + U _krnlSendMessage + U _memcpy + U _memmove +0003901c t _processExtraData + U _readLongGenericHole + U _sMemConnect + U _sMemDisconnect + U _sseek +00038f1c t _syncDeenvelopeData + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(env_enc.o): +00039bcc t _copyFromEnvelope +00039d8c t _copyToEnvelope + U _deflate +0003990c t _encodeSegmentHeader +00039d60 T _initEnvelopeStreaming + U _krnlSendMessage + U _memcpy + U _memmove + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(env_pgp.o): + U _addAction +0003a52c t _checkCryptAlgo +0003a574 t _checkHashAlgo + U _cryptlibToPgpAlgo + U _deleteUnusedActions +0003ae54 t _emitPostamble +0003a5a8 t _emitPreamble + U _findAction + U _iCryptCreateSignatureEx + U _iCryptExportKeyEx + U _initEnvelopeEncryption +0003af58 T _initPGPEnveloping +000d7f3c s _keySize.5252 + U _krnlSendMessage +000ccab0 s _mode.5251 + U _pgpProcessIV + U _pgpWritePacketHeader + U _sMemClose + U _sMemDisconnect + U _sMemOpen + U _sputc + U _swrite + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(pgp_misc.o): +0003b088 T _cryptlibToPgpAlgo + U _getHashParameters + U _krnlSendMessage + U _memcpy + U _memset +000ccabc s _pgpAlgoMap +0003b1ec T _pgpPasswordToKey +0003b390 T _pgpProcessIV +0003b100 T _pgpReadMPI +0003b02c T _pgpToCryptlibAlgo +0003b198 T _pgpWriteMPI + U _sgetc + U _sputc + U _sread + U _sseek + U _swrite +000ccbd0 s _zeroIV.4881 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(resource.o): +0003bdf8 T _addAction +0003c10c t _addDeenvelopeInfo +0003ccbc t _addEnvelopeInfo +0003b658 T _appendContentListItem +0003ba08 t _checkAction +0003bbb4 t _checkMissingInfo + U _checkObjectEncoding +0003b5dc T _createContentListItem + U _deflateInit_ +0003c004 T _deleteAction +0003b514 T _deleteActionList +0003b688 T _deleteContentList +0003bec0 T _deleteUnusedActions +0003b4dc T _findAction +0003b9b0 T _findLastAction + U _free + U _freeMemPool + U _getMemPool + U _iCryptCheckSignatureEx + U _iCryptImportKeyEx +0003b750 T _initEnvelopeEncryption +0003b968 T _initResourceHandling + U _krnlSendMessage + U _memcmp + U _memset +000ccbf0 s _mode.5850 + U _pgpPasswordToKey + U _readConstructed + U _readRawObjectTag + U _readSequence + U _readSet + U _readUniversal + U _sMemConnect + U _sMemDisconnect + U _sizeofAlgoIDex + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(md2dgst.o): +0003d908 T _MD2_Final +0003d618 T _MD2_Init +0003d82c T _MD2_Update +0003d5fc T _MD2_options +000d8bc8 d _S +0003d678 t _md2_block + U _memcpy + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(md4dgst.o): +0003ec84 T _MD4_Final +0003ee94 T _MD4_Init +0003ec7c T _MD4_Transform +0003e85c T _MD4_Update +000ccbf4 s _end.4274 +0003e004 T _md4_block_data_order +0003d9ec T _md4_block_host_order + +/opt/local/lib/libcl.dylib(md5dgst.o): +00040770 T _MD5_Final +00040980 T _MD5_Init +00040768 T _MD5_Transform +00040348 T _MD5_Update +000ccbf8 s _end.4274 +0003f7f0 T _md5_block_data_order +0003eed8 T _md5_block_host_order + +/opt/local/lib/libcl.dylib(rmddgst.o): +00043f74 T _RIPEMD160_Final +000441a4 T _RIPEMD160_Init +00043f6c T _RIPEMD160_Transform +00043b4c T _RIPEMD160_Update +000ccbfc s _end.4275 +00042148 T _ripemd160_block_data_order +000409c4 T _ripemd160_block_host_order + +/opt/local/lib/libcl.dylib(sha1dgst.o): +00046ae8 T _SHA1_Final +00046d14 T _SHA1_Init +00046ad0 T _SHA1_Transform +0004667c T _SHA1_Update +000ccc00 s _end.4011 +00045314 T _sha1_block_data_order +000441f4 T _sha1_block_host_order + +/opt/local/lib/libcl.dylib(dbxdbms.o): + U __DefaultRuneLocale + U ___maskrune +000471f8 t _closeDatabase +000ccc04 s _cmdTemplate.5440 +000ccc3c s _cmdTemplate.5457 +000ccc74 s _cmdTemplate.5464 +000ccce8 s _cmdTemplate.5481 +000cccac s _cmdTemplate.5539 +00047560 T _dbmsFormatQuery +00047458 T _dbmsFormatSQL +00047818 T _dbmsParseName +00046d64 t _dispatchCommand +00047b84 T _endDbxSession + U _free +00047a3c T _initDbxSession + U _malloc + U _memcpy + U _memset +00047dd0 T _netProcessCommand +00047164 t _openDatabase +00047250 t _performQuery +00047444 t _performStaticQuery +00047dbc t _performStaticUpdate +00047bd8 t _performUpdate + U _sNetConnect + U _sNetDisconnect + U _sread + U _strchr + U _strlen + U _strncasecmp + U _swrite + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(dbxdbx.o): +0004915c T _addCRL +000493b0 T _addCert + U _base64decode + U _base64encode + U _caAddCertRequest + U _caAddPKIUser + U _caGetIssuingUser + U _dbmsFormatQuery + U _dbmsFormatSQL + U _decodePKIUserValue +00049fdc t _deleteItemFunction + U _dynCreate + U _dynDestroy + U _endDbxSession +00049354 T _getCertKeyID +00048d50 t _getFirstItemFunction + U _getHashParameters +000488d4 T _getItemData +00049ce4 t _getItemFunction +00048fe8 T _getKeyID +0004809c T _getKeyName +000490c4 t _getNextItemFunction + U _iCryptImportCertIndirect + U _initDBMSCA + U _initDbxSession +0004814c t _initFunction +00048134 t _isBusyFunction + U _krnlSendMessage + U _memcmp + U _memcpy + U _memset + U _messageValueCryptUnused + U _messageValueCursorFirst + U _messageValueCursorNext + U _messageValueFalse + U _messageValueTrue +0004881c T _setAccessMethodDBMS +00049b14 t _setItemFunction +00048774 t _shutdownFunction + U _strcpy + U _strlen + U _strncasecmp + U _updateCertLog +000d7f40 s _value.5149 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(dbxdca.o): + U _addCRL + U _addCert + U _base64decode + U _base64encode +0004a7e0 T _caAddCertRequest +0004a6f4 T _caAddPKIUser +0004aad0 T _caGetIssuingUser +0004acc0 t _caRevokeCert +0004b2ec t _certMgmtFunction +0004a50c t _checkRequest +000d7f48 s _crlReason.5294 +000d7f44 s _crlReason.5295 + U _dbmsFormatSQL + U _getApproxTime + U _getCertKeyID + U _getItemData + U _getKeyID + U _getKeyName + U _getTime +0004ac98 T _initDBMSCA + U _krnlSendMessage + U _memcmp + U _memcpy + U _messageValueCryptUnused +0004b134 t _revokeCertDirect + U _sMemDisconnect + U _sMemOpen + U _sizeofObject + u _sprintf$LDBLStub + U _strcat + U _strcpy + U _strlen +0004a3f4 t _updateCertErrorLog +0004a168 T _updateCertLog + U _writeCharacterString + U _writeSequence + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(dbxhttp.o): +0004cb70 t _bufferAdjustCallback + U _free +0004cbe0 t _getItemFunction + U _getLongObjectLength +0004ce50 t _initFunction + U _krnlSendMessage + U _malloc + U _memcpy + U _memset + U _sNetConnect + U _sNetDisconnect + U _sNetGetErrorInfo +0004cf10 T _setAccessMethodHTTP +0004ceb8 t _shutdownFunction + U _sioctl + U _sread + U _strcpy + U _strlen + U _strncasecmp + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(dbxldap.o): + +/opt/local/lib/libcl.dylib(dbxmysql.o): + +/opt/local/lib/libcl.dylib(dbxoracl.o): + +/opt/local/lib/libcl.dylib(dbxpgp.o): + U ___toupper +0004cf4c t _checkKeyMatch +000d7f4c s _cryptMode.5856 + U _free + U _getHashParameters +0004e48c t _getItemFunction +0004e8b8 t _initPrivateFunction +0004d1a8 t _initPublicFunction + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _memmove + U _memset + U _messageValueFalse + U _messageValueTrue + U _pgpPasswordToKey + U _pgpReadPacketHeader + U _pgpToCryptlibAlgo +0004d64c t _readKeyring + U _sMemConnect + U _sMemDisconnect + U _sPeek +0004d270 T _setAccessMethodPGPPrivate +0004d228 T _setAccessMethodPGPPublic +0004d3a0 t _setItemFunction + U _sgetc +0004d2b8 t _shutdownFunction + U _sioctl + U _sread + U _sseek + U _strncasecmp + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(dbxp12.o): + +/opt/local/lib/libcl.dylib(dbxp15.o): +0004f6c8 t _deleteItemFunction +0004e944 T _findEntry + U _free +0004ec1c T _getValidityInfo +0004f3b0 t _initFunction + U _initPKCS15read + U _initPKCS15write +000df094 s _keyFileOIDselection + U _krnlSendMessage + U _malloc + U _memcmp + U _memset +0004f5d8 T _pkcs15Free +0004eb64 T _pkcs15freeEntry + U _readCMSheader + U _readKeyset + U _readLongSequence + U _readUniversal + U _sPeek +0004ecfc T _setAccessMethodPKCS15 + U _sflush +0004ed60 t _shutdownFunction + U _sioctl + U _sizeofObject + U _sseek + U _swrite + U _writeCMSheader + U _writeCharacterString + U _writeConstructed + U _writeSequence + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(dbxp15r.o): + U _checkObjectEncoding +000df0e4 s _cryptlibDataOIDselection +000df0c4 s _dataOIDselection + U _dynCreate + U _dynDestroy + U _findEntry + U _free +00051124 t _getFirstItemFunction + U _getHashParameters +00050680 t _getItemFunction +00050520 t _getNextItemFunction + U _getValidityInfo + U _iCryptImportCertIndirect + U _iCryptImportKeyEx + U _iCryptReadSubjectPublicKey +00050648 T _initPKCS15read + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _memset + U _queryAsn1Object + U _readBitStringTag + U _readBooleanTag + U _readCMSencrHeader + U _readCharacterString + U _readConstructed + U _readGeneralizedTimeTag + U _readGenericHole +0004f7a8 T _readKeyset + U _readLongConstructed + U _readOID + U _readOIDSelection + U _readOctetStringTag + U _readSequence + U _readSet + U _readShortIntegerTag + U _readUTCTimeTag + U _readUniversal + U _sMemConnect + U _sMemDisconnect + U _sPeek + U _sizeofObject + U _sread + U _sseek +000e5f5c b _trustedCertIndex.5976 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(dbxp15w.o): +0005124c t _addCert +00051dc8 t _addCertChain + U _dynCreate + U _dynDestroy + U _exportAttributeToStream + U _findEntry + U _free + U _getApproxTime + U _getHashParameters + U _getValidityInfo + U _iCryptExportKeyEx +0005122c T _initPKCS15write + U _krnlSendMessage + U _malloc + U _memcpy + U _memmove + U _memset + U _messageValueCursorFirst + U _messageValueCursorNext + U _messageValueFalse + U _messageValueTrue + U _pkcs15freeEntry + U _readIntegerTag + U _readSequence + U _sMemClose + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _sPeek +00051f98 t _setItemFunction + U _sizeofAlgoIDex + U _sizeofObject + U _sseek + U _swrite + U _writeBitString + U _writeBoolean + U _writeCMSencrHeader + U _writeCharacterString + U _writeConstructed + U _writeGeneralizedTime + U _writeOctetString + U _writeSequence + U _writeSet + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(dbxpostg.o): + +/opt/local/lib/libcl.dylib(cryptapi.o): +0005361c t _cmdCreateObject +0005391c t _cmdGetAttribute +00053a74 t _cmdGetKey +00053c14 t _cmdSetAttribute +000ccdc0 s _cmdTemplate.4698 +000cce0c s _cmdTemplate.4716 +000cce54 s _cmdTemplate.4734 +000ccea0 s _cmdTemplate.4753 +000ccee8 s _cmdTemplate.4777 +000ccf38 s _cmdTemplate.4797 +000ccf80 s _cmdTemplate.4821 +000ccfc8 s _cmdTemplate.4839 +000ccd74 s _cmdTemplate.4861 +000cd010 s _cmdTemplate.4911 +000cd05c s _cmdTemplate.4929 +000cd0a4 s _cmdTemplate.4947 +000cd0f0 s _cmdTemplate.4964 +000cd134 s _cmdTemplate.4981 +000cd174 s _cmdTemplate.4995 +000cd1b4 s _cmdTemplate.5007 +000cd1f4 s _cmdTemplate.5019 +000cd234 s _cmdTemplate.5031 +000cd27c s _cmdTemplate.5045 +000cd2c4 s _cmdTemplate.5060 +000cd308 s _cmdTemplate.5073 +000cd34c s _cmdTemplate.5088 +000cd398 s _cmdTemplate.5105 +000cd3e4 s _cmdTemplate.5121 +000cd428 s _cmdTemplate.5137 +000cd478 s _cmdTemplate.5155 +000cd4c0 s _cmdTemplate.5180 +000cd510 s _cmdTemplate.5203 +000cd59c s _cmdTemplate.5231 +000cd5e8 s _cmdTemplate.5249 +000cd550 s _cmdTemplate.5264 +000cd634 s _cmdTemplate.5279 +000cd684 s _cmdTemplate.5302 +000cd6c8 s _cmdTemplate.5328 +000cd710 s _cmdTemplate.5344 +000cd758 s _cmdTemplate.5366 +000cd7a0 s _cmdTemplate.5386 +000ccd34 s _cmdTemplate.5399 +000585bc T _cryptAddPrivateKey +00058364 T _cryptAddPublicKey +000563bc T _cryptAsyncCancel +00056260 T _cryptAsyncQuery +0005720c T _cryptCAAddItem +000577c4 T _cryptCACertManagement +00057614 T _cryptCADeleteItem +000573f8 T _cryptCAGetItem +00056c1c T _cryptCheckCert +00054c90 T _cryptCreateCert +00054970 T _cryptCreateContext +00055000 T _cryptCreateEnvelope +0005536c T _cryptCreateSession +0005681c T _cryptDecrypt +00055e40 T _cryptDeleteAttribute +000588a8 T _cryptDeleteKey +00054800 T _cryptDestroyCert +00054690 T _cryptDestroyContext +00054520 T _cryptDestroyEnvelope +000556a8 T _cryptDestroyObject +000540d0 T _cryptDestroySession +000543b0 T _cryptDeviceClose +00054b0c T _cryptDeviceCreateContext +00054e24 T _cryptDeviceOpen +00053d88 T _cryptDeviceQueryCapability +00056518 T _cryptEncrypt +00053d68 T _cryptEnd +00056f94 T _cryptExportCert +00057e98 T _cryptFlushData +00055fe0 T _cryptGenerateKey +00056120 T _cryptGenerateKeyAsync +00055818 T _cryptGetAttribute +0005598c T _cryptGetAttributeString +00058184 T _cryptGetPrivateKey +00057fc8 T _cryptGetPublicKey +00056d8c T _cryptImportCert +00053d24 T _cryptInit +00054240 T _cryptKeysetClose +00055194 T _cryptKeysetOpen +00055500 T _cryptLogin +00053f60 T _cryptLogout +00057cf8 T _cryptPopData +00057a74 T _cryptPushData +00058a58 T _cryptQueryCapability +00055b50 T _cryptSetAttribute +00055ca4 T _cryptSetAttributeString +00056adc T _cryptSignCert + U _endCryptlib +000ccdac s _errorMap.4699 +000ccdf8 s _errorMap.4717 +000cce44 s _errorMap.4735 +000cce8c s _errorMap.4754 +000cced8 s _errorMap.4778 +000ccf20 s _errorMap.4798 +000ccf70 s _errorMap.4822 +000ccfb8 s _errorMap.4840 +000ccd6c s _errorMap.4862 +000cd000 s _errorMap.4912 +000cd048 s _errorMap.4930 +000cd094 s _errorMap.4948 +000cd0dc s _errorMap.4965 +000cd128 s _errorMap.4982 +000cd16c s _errorMap.4996 +000cd1ac s _errorMap.5008 +000cd1ec s _errorMap.5020 +000cd22c s _errorMap.5032 +000cd26c s _errorMap.5046 +000cd2b4 s _errorMap.5061 +000cd2fc s _errorMap.5074 +000cd340 s _errorMap.5089 +000cd384 s _errorMap.5106 +000cd3d0 s _errorMap.5122 +000cd41c s _errorMap.5138 +000cd460 s _errorMap.5156 +000cd4b0 s _errorMap.5181 +000cd4f8 s _errorMap.5204 +000cd588 s _errorMap.5232 +000cd5d4 s _errorMap.5250 +000cd548 s _errorMap.5265 +000cd620 s _errorMap.5280 +000cd66c s _errorMap.5303 +000cd6bc s _errorMap.5329 +000cd700 s _errorMap.5345 +000cd748 s _errorMap.5367 +000cd790 s _errorMap.5387 +000ccd20 s _errorMap.5400 +000e5f60 b _initCalled + U _initCryptlib + U _krnlSendMessage + U _memcpy + U _memset + U _messageValueCryptOK + U _messageValueFalse + U _messageValueTrue + U _strlen + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptcfg.o): + U _addTrustEntry +00059560 T _commitConfigData + U _dynCreate + U _dynDestroy +00059058 T _encodeConfigData +00058f98 T _endOptions + U _enumTrustedCerts + U _fileBuildCryptlibPath + U _fileErase +000df124 s _fixedOptionInfo + U _free +00058ec4 T _getOption +00058ed4 T _getOptionString +00058ee4 T _initOptions + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _memset + U _readBooleanTag +00059684 T _readConfig + U _readGenericHole + U _readSequence + U _readShortIntegerTag + U _readUniversal + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _sPeek +00058c34 T _setOption +00058d00 T _setOptionString + U _sizeofObject + U _sseek + U _strlen + U _writeBoolean + U _writeCharacterString + U _writeSequence + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptcrt.o): + U __DefaultRuneLocale + U _addAttribute + U _addCertComponent + U _assembleCertChain +0005a060 T _certManagementFunction + U _certWriteTable +0005a068 t _certificateMessageFunction + U _checkCertUsage + U _checkCertValidity + U _checkObjectEncoding +00059ab0 T _compareSerialNumber +0005a910 T _createCertificate +0005a004 T _createCertificateIndirect +00059df4 T _createCertificateInfo +0005b18c T _cryptAddCertExtension +0005b038 T _cryptDeleteCertExtension +0005b364 T _cryptGetCertExtension + U _deleteAttribute + U _deleteAttributes + U _deleteCertComponent + U _deleteDN + U _deleteRevocationEntries + U _exportCert + U _findAttributeByOID + U _free + U _getCertComponent + U _getObjectLength +00059b68 T _iCryptImportCertIndirect +00059b6c T _iCryptReadSubjectPublicKey + U _importCert + U _krnlCreateObject + U _krnlGetObject + U _krnlReleaseObject + U _krnlSendMessage + U _memcmp + U _memcpy + U _memset + U _messageValueCryptOK + U _messageValueTrue +00059cc4 t _processCertData + U _readAlgoID + U _readGenericHole + U _readSequence + U _readUniversal + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _signCert + U _sizeofObject + U _sseek + U _strlen +0005ab50 T _textToOID + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptctx.o): + U _BN_CTX_free + U _BN_CTX_init + U _BN_MONT_CTX_free + U _BN_MONT_CTX_init + U _BN_clear + U _BN_clear_free + U _BN_init +000d7f58 s _actionFlags.6324 +000d7f54 s _actionFlagsDH.6325 +000d7f50 s _actionFlagsPGP.6326 + U _attributeCopy + U _calculateKeyID +0005b800 T _clearTempBignums +0005c1c0 t _contextMessageFunction +0005c11c T _createContext +0005b844 T _createContextFromCapability +0005b5ac T _findCapabilityInfo + U _free +0005b548 T _getCapabilityInfo +0005b754 T _getInfo + U _initKeyHandling +0005b5e8 T _initKeyParams + U _initKeyReadWrite + U _krnlCreateObject + U _krnlMemfree + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _memset + U _messageValueCryptOK + U _messageValueCryptUnused +0005be24 t _processDeleteAttribute + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _strcpy + U _strlen + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptdbx.o): + U _attributeCopy +0005de68 T _createKeyset + U _fileClearToEOF + U _fileErase + U _fileReadonly + U _free + U _getHashParameters +000e5f64 b _initLevel.6088 +0005e6b4 T _keysetManagementFunction +0005e708 t _keysetMessageFunction + U _krnlCreateObject + U _krnlSendMessage + U _memcpy + U _memset + U _messageValueCryptOK + U _pgpReadPacketHeader + U _readLongSequence + U _readOID + U _readShortIntegerTag +0005ddbc T _retExtFnKeyset + U _sFileClose + U _sFileOpen + U _sPeek + U _setAccessMethodDBMS + U _setAccessMethodHTTP + U _setAccessMethodPGPPrivate + U _setAccessMethodPGPPublic + U _setAccessMethodPKCS15 + U _sgetc + U _sioctl + U _sseek + U _strcpy + U _strlen + U _strncasecmp + u _vsprintf$LDBLStub + U _waitSemaphore + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptdev.o): + U _attributeCopy + U _checkEntropy + U _createCertificateIndirect + U _createContext +0005fb40 T _createDevice +000df480 s _defaultCreateFunctions +0005ef10 T _deviceManagementFunction +0005f0bc t _deviceMessageFunction + U _findCapabilityInfo + U _free + U _getCapabilityInfo +000e5f68 b _initFlags.4785 + U _krnlCreateObject + U _krnlGetObject + U _krnlReleaseObject + U _krnlSendMessage + U _memset + U _messageValueCryptOK + U _messageValueCryptUnused + U _setDeviceSystem + U _strlen + U _waitSemaphore + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptenv.o): + U _attributeCopy +000cd7d8 s _checkTable.5338 +00060144 T _createEnvelope +0005fdf0 t _deenvelopePush + U _deflateEnd + U _deleteActionList + U _deleteContentList +0006030c t _envelopeMessageFunction + U _free + U _inflateEnd + U _initCMSDeenveloping + U _initCMSEnveloping + U _initDeenvelopeStreaming + U _initEnvelopeStreaming + U _initMemPool + U _initPGPDeenveloping + U _initPGPEnveloping + U _initResourceHandling + U _krnlCreateObject + U _krnlSendMessage + U _malloc + U _memcpy + U _memset + U _messageValueCryptOK + U _messageValueCryptUnused + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptkey.o): + U _clearTempBignums +00061e5c t _generateKeyConvFunction +00062014 t _generateKeyMacFunction +00061f28 t _generateKeyPKCFunction + U _getApproxTime +000620d8 T _initKeyHandling + U _krnlSendMessage +00061b90 t _loadKeyConvFunction +00061da0 t _loadKeyMacFunction +00061bd0 t _loadKeyPKCFunction + U _messageValueCryptOK + U _pthread_create + U _pthread_exit +00061db0 T _threadKeygen + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptkrn.o): +000cd8a4 s _OBJECT_INFO_TEMPLATE +000cd898 s _OBJECT_STATE_INFO_TEMPLATE +000cd88c s _SEMAPHORE_INFO_TEMPLATE +000ceaec s _accessTypeTbl.4954 +000e60e8 b _allocatedListHead +000e60e4 b _allocatedListTail +000e6064 b _allocationMutex +000e6090 b _allocationMutexInitialised +000e60cc b _allocationMutexLockcount +000e60ec b _allocationMutexOwner +000cea64 s _allowedCertCursorSubranges +000cea4c s _allowedIPAddressSizes +000cea88 s _allowedKeyingAlgos +000cea9c s _allowedLDAPObjectTypes +000ce96c s _allowedObjectStatusValues +000cea7c s _allowedPKCKeysizes +000643a8 T _beginInitialisation +000e1e94 s _certExtensionACL +000e326c s _certNameACL +000e14bc s _certSmimeACL +000e34ec s _certificateACL +00062fd4 t _checkTargetType +00063944 T _clearSemaphore +00066e90 t _cloneObject +000e3b2c s _contextACL +00066a60 t _decRefCount +00066bdc T _destroyObjects +000e132c s _deviceACL +000644bc T _endInitialisation +00064554 T _endInternalFunctions +00063c50 T _enterMutex +000e0e54 s _envelopeACL +00063dbc T _exitMutex +000663ac T _exportPrivateKeyData +00064324 T _extractKeyData +000679b0 t _findCompareMessageTarget +00062bb4 t _findTargetType +000e45cc s _formatPseudoACL.5249 + U _free +000e4414 s _genericACL +0006410c t _getContext +00066f58 t _getDependentObject + U _getTime +000662c4 T _importPrivateKeyData +00062b80 t _incRefCount +0006471c T _initInternalFunctions +000e609c b _initialisationMutex +000e6098 b _initialisationMutexInitialised +000e60c8 b _initialisationMutexLockcount +000e6274 b _initialisationMutexOwner +000dfa54 s _internalACL +000e5f70 b _isClosingDown +000e6094 b _isInitialised +000cd8e8 s _keyManagementACL +000e146c s _keysetACL +00064a78 T _krnlCreateObject +000624cc T _krnlGetObject +00063e5c T _krnlMemalloc +00063fac T _krnlMemfree +000640f0 T _krnlMemsize +000627d8 T _krnlReacquireSystemObject +00062708 T _krnlReleaseObject +00062710 T _krnlReleaseSystemObject +00064f4c T _krnlSendMessage +000ceaac s _lfsrPolyTable.4289 + U _malloc +000cdb94 s _mechanismDeriveACL +000cdef8 s _mechanismSigCheckACL +000cdff0 s _mechanismSignACL +000ce0e8 s _mechanismUnwrapACL +000ce544 s _mechanismWrapACL + U _memcpy + U _memset +000df490 s _messageHandlingInfo +000e6118 b _messageQueue +000d7f74 S _messageValueCryptError +000d7f78 S _messageValueCryptOK +000d7f70 S _messageValueCryptSignalled +000d7f38 S _messageValueCryptUnused +000d7f6c S _messageValueCryptUseDefault +000d7f68 S _messageValueCursorFirst +000d7f5c S _messageValueCursorLast +000d7f64 S _messageValueCursorNext +000d7f60 S _messageValueCursorPrevious +000d7f78 S _messageValueFalse +000d7f7c S _messageValueTrue + U _mlock + U _munlock +000e5fa4 b _mutex1Mutex +000e5fd0 b _mutex1MutexInitialised +000e60d8 b _mutex1MutexLockcount +000e60f8 b _mutex1MutexOwner +000e5fd4 b _mutex2Mutex +000e6000 b _mutex2MutexInitialised +000e60d4 b _mutex2MutexLockcount +000e60f4 b _mutex2MutexOwner +000e6004 b _mutex3Mutex +000e6030 b _mutex3MutexInitialised +000e60d0 b _mutex3MutexLockcount +000e60f0 b _mutex3MutexOwner +000cea34 s _objectCMSAttr +000ce948 s _objectCertOCSPRequest +000ce9a4 s _objectCertOCSPResponse +000ce930 s _objectCertPKIUser +000ce954 s _objectCertRTCSRequest +000ce9b0 s _objectCertRTCSResponse +000cea58 s _objectCertRequest +000ce93c s _objectCertRevRequest +000ce9c8 s _objectCertSessionCMPRequest +000ce9d4 s _objectCertSessionOCSPRequest +000ce9e0 s _objectCertSessionRTCSRequest +000ce9bc s _objectCertSessionUnsignedPKCS10Request +000ce960 s _objectCertificate +000cea40 s _objectCtxConv +000ce98c s _objectCtxHash +000cea10 s _objectCtxPKC +000ce998 s _objectDeenvelope +000cea1c s _objectKeyset +000cea04 s _objectKeysetCerts +000ce924 s _objectKeysetConfigdata +000ce980 s _objectKeysetPrivate +000ce9f8 s _objectSessionDataClient +000ce9ec s _objectSessionDataServer +000cea28 s _objectSessionTSP +000e6258 b _objectStateInfo +000e6270 b _objectTable +000e5f78 b _objectTableMutex +000e5f6c b _objectTableMutexInitialised +000e5f74 b _objectTableMutexLockcount +000e6268 b _objectTableMutexOwner +000e626c b _objectTableSize +000e6264 b _objectUniqueID +000e3dac s _optionACL +000cd85c s _paramACLTbl +000637d0 t _postDispatchChangeState +00063804 t _postDispatchChangeStateOpt +00066484 t _postDispatchForwardToDependentObject +000665b4 t _postDispatchMakeObjectExternal +00063794 t _postDispatchUpdateUsageCount +0006301c t _preDispatchCheckActionAccess +00067304 t _preDispatchCheckAttributeAccess +00063434 t _preDispatchCheckCertMgmtAccess +00063014 t _preDispatchCheckCompareParam +00063350 t _preDispatchCheckData +00067964 t _preDispatchCheckExportAccess +00068574 t _preDispatchCheckKeysetAccess +000633d8 t _preDispatchCheckMechanismDeriveAccess +000681e8 t _preDispatchCheckMechanismSignAccess +00067da8 t _preDispatchCheckMechanismWrapAccess +00063108 t _preDispatchCheckParamHandleOpt +000630cc t _preDispatchCheckState +00063224 t _preDispatchCheckStateParamHandle +00063394 t _preDispatchSetObjectOwner +00066b60 t _preDispatchSignalDependentObjects +000e44dc s _propertyACL + U _pthread_equal + U _pthread_join + U _pthread_mutex_destroy + U _pthread_mutex_init + U _pthread_mutex_lock + U _pthread_mutex_trylock + U _pthread_mutex_unlock + U _pthread_self + U _pthread_yield_np +000e60e0 b _queueEnd +000622d0 t _releaseObject +000e6100 b _semaphoreInfo +000e6034 b _semaphoreMutex +000e6060 b _semaphoreMutexInitialised +000e60dc b _semaphoreMutexLockcount +000e60fc b _semaphoreMutexOwner +000e04cc s _sessionACL +00066708 t _setDependentObject +000628a0 t _setPropertyAttribute +00063844 T _setSemaphore +000e3ab4 s _subACL_CertinfoFingerprintSHA +000e3a3c s _subACL_CertinfoSerialNumber +000e12b4 s _subACL_EnvinfoContentType +000e123c s _subACL_EnvinfoSignature +000e11c4 s _subACL_EnvinfoSignatureExtraData +000e038c s _subACL_IAttributeSubject +000e0ddc s _subACL_SessinfoActive +000e0c4c s _subACL_SessinfoPassword +000e0864 s _subACL_SessinfoPortforward +000e0bd4 s _subACL_SessinfoPrivatekey +000e0a94 s _subACL_SessinfoRequest +000e0954 s _subACL_SessinfoRequesttype +000e09cc s _subACL_SessinfoResponse +000e0b5c s _subACL_SessinfoSession +000e08dc s _subACL_SessinfoSubsystem +000e0d14 s _subACL_SessinfoUsername +000e0404 s _userACL +00062158 t _waitForObject +00063a5c T _waitSemaphore + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptlib.o): +000e47a0 s _asyncInitFunctions + U _beginInitialisation + U _clearSemaphore +00068964 t _des3TestLoop + U _des_ecb3_encrypt + U _des_set_key_unchecked + U _destroyObjects + U _deviceManagementFunction +00069734 T _endCryptlib + U _endInitialisation + U _endInternalFunctions + U _getHashParameters +00068a8c T _initCryptlib +000e47b0 s _initFunctions + U _initInternalFunctions +000d011c s _key.4482 + U _keysetManagementFunction + U _krnlSendMessage +000e4814 s _md5Vectors.4435 + U _memcmp + U _memset + U _messageValueFalse + U _messageValueTrue +000e47b8 s _preInitFunctions +000e4794 s _preShutdownFunctions + U _pthread_create + U _pthread_exit + U _sessionManagementFunction + U _setSemaphore +000e47c0 s _sha1Vectors.4440 +000e4784 s _shutdownFunctions +000cecdc s _testDP +000cfb1c s _testIP +000cefdc s _testKP +000ceb14 s _testSB +000cf51c s _testVP +00068a30 T _threadedBind + U _userManagementFunction + U _waitSemaphore + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptmch.o): + U _cryptlibToPgpAlgo +0006999c T _deriveCMP +00069a78 T _derivePGP +0006b9bc T _derivePKCS5 +00069800 T _deriveSSL +0006be58 T _deriveTLS +0006a464 T _exportCMS +0006af3c T _exportPKCS1 +0006af30 T _exportPKCS1PGP +0006ac10 T _exportPrivateKey + U _exportPrivateKeyData +0006ac20 T _exportPrivateKeyPKCS8 + U _extractKeyData + U _getHashParameters + U _getObjectLength +0006a644 T _importCMS +0006a444 T _importPKCS1 +0006a458 T _importPKCS1PGP +0006ac18 T _importPrivateKey + U _importPrivateKeyData +0006b9ac T _importPrivateKeyOpenPGP +0006b9b4 T _importPrivateKeyPGP +0006ac28 T _importPrivateKeyPKCS8 + U _krnlMemalloc + U _krnlMemfree + U _krnlSendMessage + U _memcmp + U _memcpy + U _memset +000d0128 s _mode.5351 + U _pgpToCryptlibAlgo +00069f84 t _pkcs1Unwrap +0006ac30 t _pkcs1Wrap +0006aa94 t _privateKeyUnwrap +0006b244 t _privateKeyUnwrapPGP +0006a870 t _privateKeyWrap + U _readMessageDigest + U _sMemClose + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _sgetc +0006af54 T _sigcheckPKCS1 +00069d10 T _signPKCS1 + U _sizeofAlgoID + U _sizeofObject + U _sputc + U _sseek + U _writeMessageDigest + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptmis.o): +000d026c s _C.13.5014 + U __DefaultRuneLocale + U ___maskrune + U ___toupper +0006e48c T _addMIMEchar +0006df84 T _adjustPKIUserValue +0006cc9c T _algoAvailable +000d016c s _asciiToBin +0006cc34 T _attributeCopy +0006e64c T _base64checkHeader +0006dabc T _base64decode +0006ddfc T _base64decodeLen +0006d844 T _base64encode +0006de90 T _base64encodeLen +000bb924 s _binToAscii +0006cafc T _checkEntropy +0006ca0c T _checksumData +000bb734 s _codeTable +0006dfd0 T _decodePKIUserValue +0006ccd4 T _dynCreate +0006cde4 T _dynDestroy +0006e2a0 T _encodePKIUserValue +0006d83c T _endMIMEstate +0006d5b8 T _envelopeSigCheck +0006d384 T _envelopeSign +0006d1ec T _envelopeUnwrap +0006d010 T _envelopeWrap +0006cec0 T _exportAttributeToStream +0006cf68 T _exportCertToStream + U _free +0006ce94 T _freeMemPool +0006c914 T _getApproxTime +0006ca4c T _getHashParameters +0006ce5c T _getMemPool +0006c950 T _getReliableTime +0006c8dc T _getTime +000e48d4 s _headerInfo +000d014c s _hiMask +0006d81c T _initMIMEstate +0006ce48 T _initMemPool +0006ea74 T _isPKIUserValue + U _krnlSendMessage +000d012c s _loMask + U _malloc + U _md2HashBuffer + U _md5HashBuffer + U _memcmp + U _memcpy + U _memset + U _messageValueTrue + U _ripemd160HashBuffer + U _sMemConnect + U _sMemDisconnect + U _sPeek + U _sgetc + U _shaHashBuffer + U _sread + U _sseek + U _strcpy + U _strlen + U _strncasecmp + U _strncmp + U _time + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptses.o): + U _attributeCopy + U _checkObjectEncoding +0006ef08 T _createSession + U _decodePKIUserValue +00070dec t _defaultClientStartupFunction +0006ec68 t _defaultGetAttributeFunction +00070c38 t _defaultServerStartupFunction +0006ec60 t _defaultShutdownFunction + U _endSessionCache + U _free +000e6278 b _initLevel.6256 + U _initSessionCache +0006ebc0 T _initSessionNetConnectInfo + U _isPKIUserValue + U _krnlCreateObject + U _krnlSendMessage + U _malloc + U _memcpy + U _memmove + U _memset + U _messageValueCryptOK + U _messageValueCryptUnused + U _messageValueTrue + U _netEndTCP + U _netInitTCP + U _netSignalShutdown +0006f3a4 t _processSetAttribute +0006ecc4 T _readFixedHeader +0006edd0 T _readPkiDatagram +0006eb58 T _retExtFnSession + U _sNetConnect + U _sNetDisconnect + U _sNetGetErrorInfo + U _sNetListen + U _sNetParseURL +0006f2cc T _sessionManagementFunction +0006fbcc t _sessionMessageFunction +000d027c s _sessionTypes.6172 + U _setAccessMethodCMP + U _setAccessMethodOCSP + U _setAccessMethodRTCS + U _setAccessMethodSCEP + U _setAccessMethodSSH + U _setAccessMethodSSL + U _setAccessMethodTSP + U _sioctl + U _sread + U _strlen + U _strncasecmp + U _swrite + u _vsprintf$LDBLStub + U _waitSemaphore +0006eea8 T _writePkiDatagram + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cryptusr.o): + U _addTrustEntry + U _attributeCopy + U _commitConfigData +0007134c T _createUser +000d0330 s _defaultUserInfo + U _deleteTrustEntry + U _encodeConfigData + U _endOptions + U _endTrustInfo + U _enumTrustedCerts + U _fileBuildCryptlibPath + U _fileClearToEOF + U _fileErase + U _findTrustEntry +00070f78 t _findUser + U _free + U _getOption + U _getOptionString + U _getTrustedCert + U _iCryptCheckSignatureEx + U _initOptions + U _initTrustInfo + U _krnlCreateObject + U _krnlGetObject + U _krnlReleaseObject + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _memmove + U _memset + U _messageValueCryptOK + U _messageValueCryptUnused + U _messageValueTrue +000d7f80 s _minBufferSize.5569 +000710fc t _openUser +000d03ac s _primarySOInfo + U _readAlgoID + U _readCharacterString + U _readConfig + U _readConstructed + U _readEnumeratedTag + U _readGenericHole + U _readOctetStringTag + U _readSequence + U _readSet + U _readShortIntegerTag + U _readUniversal + U _sFileClose + U _sFileOpen + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _setOption + U _setOptionString + U _sizeofObject + u _sprintf$LDBLStub + U _strlen + U _strncasecmp +00071270 T _userManagementFunction +00072044 t _userMessageFunction + U _writeCharacterString + U _writeEnumerated + U _writeOctetString + U _writeSequence + U _writeShortInteger +000d0428 s _zeroUserData.5612 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_3des.o): +000734ac T _des3DecryptCBC +0007363c T _des3DecryptCFB +000733f4 T _des3DecryptECB +000738dc T _des3DecryptOFB +0007346c T _des3EncryptCBC +000734ec T _des3EncryptCFB +0007337c T _des3EncryptECB +000737b0 T _des3EncryptOFB +00073368 T _des3GetInfo +00073a08 T _des3InitKey +000732b8 T _des3SelfTest +000731ec t _des3TestLoop + U _des_ecb3_encrypt + U _des_ede3_cbc_encrypt + U _des_key_sched + U _des_set_key_unchecked + U _des_set_odd_parity + U _getInfo + U _memcmp + U _memcpy +000d05f2 s _testDP +000d1432 s _testIP +000d08f2 s _testKP +000d042a s _testSB +000d0e32 s _testVP + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_aes.o): +00073de0 T _aesDecryptCBC +00073ff0 T _aesDecryptCFB +00073cc4 T _aesDecryptECB +00074268 T _aesDecryptOFB +00073d2c T _aesEncryptCBC +00073eb4 T _aesEncryptCFB +00073c60 T _aesEncryptECB +00074150 T _aesEncryptOFB +00073c4c T _aesGetInfo +00074380 T _aesInitKey +00073ad8 T _aesSelfTest + U _aes_decrypt + U _aes_decrypt_key + U _aes_decrypt_key128 + U _aes_decrypt_key192 + U _aes_decrypt_key256 + U _aes_encrypt + U _aes_encrypt_key + U _aes_encrypt_key128 + U _aes_encrypt_key192 + U _aes_encrypt_key256 + U _getInfo + U _memcmp + U _memcpy +000d1a34 s _testAES + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_bf.o): + U _BF_cbc_encrypt + U _BF_ecb_encrypt + U _BF_set_key +000d1b28 s _C.0.6292 +000d1b20 s _C.1.6293 +000d1b18 s _C.2.6294 +000d1b10 s _C.3.6295 +000d1b08 s _C.4.6296 +000d1b00 s _C.5.6297 +0007474c T _blowfishDecryptCBC +000748c4 T _blowfishDecryptCFB +000746ac T _blowfishDecryptECB +00074b44 T _blowfishDecryptOFB +00074714 T _blowfishEncryptCBC +00074784 T _blowfishEncryptCFB +00074644 T _blowfishEncryptECB +00074a28 T _blowfishEncryptOFB +00074630 T _blowfishGetInfo +00074c60 T _blowfishInitKey +000743ec T _blowfishSelfTest + U _getInfo + U _memcmp + U _memcpy + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_cast.o): + U _CAST_cbc_encrypt + U _CAST_ecb_encrypt + U _CAST_set_key +00074e58 T _castDecryptCBC +00074fcc T _castDecryptCFB +00074dbc T _castDecryptECB +00075244 T _castDecryptOFB +00074e20 T _castEncryptCBC +00074e90 T _castEncryptCFB +00074d58 T _castEncryptECB +0007512c T _castEncryptOFB +00074d44 T _castGetInfo +0007535c T _castInitKey +00074cb8 T _castSelfTest + U _getInfo + U _memcmp + U _memcpy +000d1b30 s _testCAST + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_des.o): +000754c8 T _desDecryptCBC +0007563c T _desDecryptCFB +0007542c T _desDecryptECB +000758b4 T _desDecryptOFB +00075490 T _desEncryptCBC +00075500 T _desEncryptCFB +000753c8 T _desEncryptECB +0007579c T _desEncryptOFB +000753b4 T _desGetInfo +000759cc T _desInitKey +00075a38 T _desSelfTest + U _des_ecb_encrypt + U _des_key_sched + U _des_ncbc_encrypt + U _des_set_key_unchecked + U _des_set_odd_parity + U _getInfo + U _memcmp + U _memcpy +000d1d18 s _testDP +000d3098 s _testIP +000d2558 s _testKP +000d2018 s _testRS +000d1b50 s _testSB +000d2a98 s _testVP + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_dh.o): + U _BN_CTX_free + U _BN_CTX_init + U _BN_MONT_CTX_free + U _BN_MONT_CTX_init + U _BN_bin2bn + U _BN_bn2bin + U _BN_clear_free + U _BN_init + U _BN_mod_exp_mont + U _calculateKeyID +000d3794 s _capabilityInfo.6258 + U _checkDLPkey +00075cf4 T _dhDecrypt +00075cb8 T _dhEncrypt +00075f38 T _dhGenerateKey +00075de0 T _dhInitKey +00075f8c T _dhSelfTest +000d3698 s _dlpTestKey + U _generateDLPkey + U _initDLPkey + U _initKeyReadWrite + U _memcmp + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_dsa.o): + U _BN_CTX_free + U _BN_CTX_init + U _BN_MONT_CTX_free + U _BN_MONT_CTX_init + U _BN_add + U _BN_bin2bn + U _BN_clear_free + U _BN_cmp + U _BN_div + U _BN_init + U _BN_mod_exp2_mont + U _BN_mod_exp_mont + U _BN_mod_inverse + U _BN_mod_mul + U _BN_sub + U _calculateKeyID +000d3924 s _capabilityInfo.6258 + U _checkDLPkey + U _decodeDLValues +000d3828 s _dlpTestKey +00076c4c T _dsaGenerateKey +00076880 T _dsaInitKey +000769a8 T _dsaSelfTest +000766f4 T _dsaSigCheck +00076514 T _dsaSign + U _encodeDLValues + U _generateBignum + U _generateDLPkey + U _initDLPkey + U _initKeyReadWrite +000d3800 s _kVal + U _memset +000d3814 s _shaM + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_elg.o): + U _BN_CTX_free + U _BN_CTX_init + U _BN_MONT_CTX_free + U _BN_MONT_CTX_init + U _BN_bin2bn + U _BN_bn2bin + U _BN_clear_free + U _BN_cmp + U _BN_copy + U _BN_div + U _BN_gcd + U _BN_init + U _BN_mod_exp_mont + U _BN_mod_inverse + U _BN_mod_mul + U _BN_num_bits + U _BN_sub_word + U _calculateKeyID +000d3acc s _capabilityInfo.6258 + U _checkDLPkey + U _decodeDLValues +000d39d0 s _dlpTestKey +00076f18 T _elgamalDecrypt +00076cac T _elgamalEncrypt +000774d8 T _elgamalGenerateKey +00077078 T _elgamalInitKey +000771fc T _elgamalSelfTest + U _encodeDLValues + U _generateBignum + U _generateDLPkey + U _initDLPkey + U _initKeyReadWrite +000d3990 s _kRandomVal + U _memcmp + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_hmd5.o): + U _MD5_Final + U _MD5_Init + U _MD5_Update + U _getInfo +0007752c T _hmacMD5GetInfo +00077658 T _hmacMD5Hash +00077540 T _hmacMD5InitKey +00077780 T _hmacMD5SelfTest +000e4928 s _hmacValues + U _memcmp + U _memcpy + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_hrmd.o): + U _RIPEMD160_Final + U _RIPEMD160_Init + U _RIPEMD160_Update + U _getInfo +0007789c T _hmacRIPEMD160GetInfo +000779c0 T _hmacRIPEMD160Hash +000778b0 T _hmacRIPEMD160InitKey +00077ae8 T _hmacRIPEMD160SelfTest +000e4a08 s _hmacValues + U _memcmp + U _memcpy + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_hsha.o): + U _SHA1_Final + U _SHA1_Init + U _SHA1_Update + U _getInfo +00077c00 T _hmacSHAGetInfo +00077d24 T _hmacSHAHash +00077c14 T _hmacSHAInitKey +00077e4c T _hmacSHASelfTest +000e4a2c s _hmacValues + U _memcmp + U _memcpy + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_idea.o): + U _getInfo +0007815c T _ideaDecryptCBC +000782d4 T _ideaDecryptCFB +000780bc T _ideaDecryptECB +0007854c T _ideaDecryptOFB +00078124 T _ideaEncryptCBC +00078198 T _ideaEncryptCFB +00078058 T _ideaEncryptECB +00078434 T _ideaEncryptOFB +00078044 T _ideaGetInfo +00078664 T _ideaInitKey +00077f64 T _ideaSelfTest + U _idea_cbc_encrypt + U _idea_ecb_encrypt + U _idea_set_decrypt_key + U _idea_set_encrypt_key + U _memcmp + U _memcpy +000d3b38 s _testIdea + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_kg.o): + U _BN_MONT_CTX_init + U _BN_MONT_CTX_set + U _BN_add_word + U _BN_bin2bn + U _BN_clear_free + U _BN_cmp + U _BN_copy + U _BN_div + U _BN_get_word + U _BN_init + U _BN_is_bit_set + U _BN_lshift1 + U _BN_mod_exp + U _BN_mod_exp_mont + U _BN_mod_inverse + U _BN_mod_mul + U _BN_mod_word + U _BN_mul + U _BN_num_bits + U _BN_rshift + U _BN_rshift1 + U _BN_set_word + U _BN_sub + U _BN_sub_word + U _BN_swap +000790e8 T _checkDLPkey + U _free +000786c8 T _generateBignum +00079de0 T _generateDLPkey +00079c28 t _generateDLPrivateValue +000795f8 t _generateDLPublicValues +000792f8 t _generatePrime +00079e94 T _generateRSAkey +000789c8 T _initCheckRSAkey +0007a0d8 T _initDLPkey + U _krnlSendMessage + U _malloc + U _memset +000787c4 t _primeProbable +000d3c98 s _primes +000d5c98 s _smallPrimes.5983 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_md2.o): + U _MD2_Final + U _MD2_Init + U _MD2_Update +000e4b28 s _digestValues + U _getInfo +0007a2e0 T _md2GetInfo +0007a2f4 T _md2Hash +0007a370 T _md2HashBuffer +0007a438 T _md2SelfTest + U _memcmp + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_md4.o): + U _MD4_Final + U _MD4_Init + U _MD4_Update +000e4be8 s _digestValues + U _getInfo +0007a5a8 T _md4GetInfo +0007a5bc T _md4Hash +0007a4f8 T _md4SelfTest + U _memcmp + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_md5.o): + U _MD5_Final + U _MD5_Init + U _MD5_Update +000e4ca8 s _digestValues + U _getInfo +0007a638 T _md5GetInfo +0007a64c T _md5Hash +0007a6c8 T _md5HashBuffer +0007a790 T _md5SelfTest + U _memcmp + U _memset + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_rc2.o): + U _RC2_cbc_encrypt + U _RC2_ecb_encrypt + U _RC2_set_key + U _getInfo + U _memcmp + U _memcpy +0007a9fc T _rc2DecryptCBC +0007ab74 T _rc2DecryptCFB +0007a95c T _rc2DecryptECB +0007adf4 T _rc2DecryptOFB +0007a9c4 T _rc2EncryptCBC +0007aa34 T _rc2EncryptCFB +0007a8f4 T _rc2EncryptECB +0007acd8 T _rc2EncryptOFB +0007a8e0 T _rc2GetInfo +0007af10 T _rc2InitKey +0007a850 T _rc2SelfTest +000d5f3c s _testRC2 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_rc4.o): + U _RC4 + U _RC4_set_key + U _getInfo + U _memcmp + U _memcpy +0007af84 T _rc4Encrypt +0007af70 T _rc4GetInfo +0007afc0 T _rc4InitKey +0007b018 T _rc4SelfTest +000d63c8 s _testRC4ciphertext1 +000d63b0 s _testRC4ciphertext2 +000d6398 s _testRC4ciphertext3 +000d637c s _testRC4ciphertext4 +000d5f74 s _testRC4ciphertext5 +000d5f5c s _testRC4ciphertext6 +000d63d8 s _testRC4key1 +000d63c0 s _testRC4key2 +000d63a8 s _testRC4key3 +000d6394 s _testRC4key4 +000d6374 s _testRC4key5 +000d5f6c s _testRC4key6 +000d63d0 s _testRC4plaintext1 +000d63b8 s _testRC4plaintext2 +000d63a0 s _testRC4plaintext3 +000d6388 s _testRC4plaintext4 +000d6174 s _testRC4plaintext5 +000d5f64 s _testRC4plaintext6 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_rc5.o): + U _RC5_32_cbc_encrypt + U _RC5_32_ecb_encrypt + U _RC5_32_set_key + U _getInfo + U _memcmp + U _memcpy +0007b454 T _rc5DecryptCBC +0007b5cc T _rc5DecryptCFB +0007b3b4 T _rc5DecryptECB +0007b84c T _rc5DecryptOFB +0007b41c T _rc5EncryptCBC +0007b48c T _rc5EncryptCFB +0007b34c T _rc5EncryptECB +0007b730 T _rc5EncryptOFB +0007b338 T _rc5GetInfo +0007b968 T _rc5InitKey +0007b284 T _rc5SelfTest +000d63e0 s _testRC5 + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_ripe.o): + U _RIPEMD160_Final + U _RIPEMD160_Init + U _RIPEMD160_Update +000e4d68 s _digestValues + U _getInfo + U _memcmp + U _memset +0007b9c8 T _ripemd160GetInfo +0007b9dc T _ripemd160Hash +0007ba58 T _ripemd160HashBuffer +0007bb20 T _ripemd160SelfTest + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_rsa.o): + U _BN_CTX_free + U _BN_CTX_init + U _BN_MONT_CTX_free + U _BN_MONT_CTX_init + U _BN_add + U _BN_bin2bn + U _BN_bn2bin + U _BN_clear_free + U _BN_div + U _BN_init + U _BN_mod_exp_mont + U _BN_mod_mul + U _BN_mul + U _BN_num_bits + U _BN_sub + U _calculateKeyID +000d65c4 s _capabilityInfo.6262 + U _generateRSAkey + U _initCheckRSAkey + U _initKeyReadWrite + U _memcmp + U _memset +0007bcf4 T _rsaDecrypt +0007bbe0 T _rsaEncrypt +0007c120 T _rsaGenerateKey +0007bfc8 T _rsaInitKey +0007c16c T _rsaSelfTest +000d6480 s _rsaTestKey + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_sha.o): + U _SHA1_Final + U _SHA1_Init + U _SHA1_Update +000e4e64 s _digestValues + U _getInfo + U _memcmp + U _memset +0007c7e4 T _shaGetInfo +0007c7f8 T _shaHash +0007c874 T _shaHashBuffer +0007c93c T _shaSelfTest + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(lib_skip.o): + U _getInfo + U _memcmp + U _memcpy + U _skipjackDecrypt +0007cbf4 T _skipjackDecryptCBC +0007cdd8 T _skipjackDecryptCFB +0007caf4 T _skipjackDecryptECB +0007d048 T _skipjackDecryptOFB + U _skipjackEncrypt +0007cb54 T _skipjackEncryptCBC +0007cca0 T _skipjackEncryptCFB +0007ca94 T _skipjackEncryptECB +0007cf34 T _skipjackEncryptOFB +0007ca80 T _skipjackGetInfo +0007d15c T _skipjackInitKey + U _skipjackMakeKey +0007c9fc T _skipjackSelfTest +000d6630 s _testSkipjack + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(asn1_rw.o): + U _BN_bin2bn + U _BN_bn2bin + U _BN_high_bit + U _BN_num_bits +0007fd10 t _checkASN1 +0007d7a8 T _checkEOC +000805a0 T _checkObjectEncoding +000804a8 T _getLongObjectLength +00080704 T _getObjectLength +00080624 T _getStreamObjectLength + U _gmtime + U _memset + U _mktime +0007da1c T _readBignumTag +00080d84 T _readBitStringHole +0007df70 T _readBitStringTag +0007dd80 T _readBooleanTag +0007de44 T _readCharacterString +00080a9c T _readConstructed +00080b94 T _readConstructedI +0007dba0 T _readEnumeratedTag +0007e934 T _readGeneralizedTimeTag +0007e0e4 T _readGenericHole +0007ed94 T _readIntegerTag +0007d81c t _readLengthValue +0007eb1c T _readLongConstructed +0007e1d4 T _readLongGenericHole +0007ea74 T _readLongSequence +0007dce4 T _readNullTag +00080c8c T _readOctetStringHole +0007ef04 T _readOctetStringTag +0007ec14 T _readRawObjectTag +000807fc T _readSequence +000808a4 T _readSequenceI +0008094c T _readSet +000809f4 T _readSetI +0007e324 T _readShortIntegerTag +0007e59c t _readTime +0007e9d4 T _readUTCTimeTag +0007e2c4 T _readUniversal +0007db48 T _readUniversalData + U _sMemConnect + U _sMemDisconnect + U _sPeek + U _sgetc +0007d218 T _signedBignumSize +0007d1b0 T _sizeofObject + u _sprintf$LDBLStub + U _sputc + U _sread + U _sseek + U _swrite +0007f04c T _writeBignumTag +0007d534 T _writeBitString +0007fad8 T _writeBitStringHole +0007d4d0 T _writeBoolean +0007f574 T _writeCharacterString +0007f8a0 T _writeConstructed +0007d34c T _writeEnumerated +0007d6d4 T _writeGeneralizedTime +0007fc08 T _writeGenericHole +0007f2ac T _writeInteger +0007d260 T _writeLength +0007d484 T _writeNull +0007f444 T _writeOctetString +0007f9bc T _writeOctetStringHole +0007f690 T _writeSequence +0007f798 T _writeSet +0007e464 T _writeShortInteger +0007d5e4 T _writeUTCTime + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(asn1s_rw.o): +000e4eb8 s _algoIDmap +00082250 T _checkAlgoID + U _checkEOC + U _krnlSendMessage + U _memcmp + U _memset +000824d8 T _readAlgoID +00082358 T _readAlgoIDex +000825c4 T _readCMSencrHeader +00081c08 T _readCMSheader + U _readConstructed +000816c8 T _readContextAlgoID + U _readLongConstructed + U _readLongGenericHole + U _readLongSequence +000824e4 T _readMessageDigest + U _readNullTag +00080e9c T _readOID +00080f20 T _readOIDSelection + U _readOctetStringTag + U _readRawObjectTag + U _readSequence + U _readShortIntegerTag + U _sMemClose + U _sMemOpen + U _sPeek +00082548 T _sizeofAlgoID +000822cc T _sizeofAlgoIDex +00082070 T _sizeofCMSencrHeader +000827a4 T _sizeofContextAlgoID + U _sizeofObject + U _sputc + U _sseek + U _swrite +00082a34 T _writeAlgoID +000815e4 T _writeAlgoIDex +00082120 T _writeCMSencrHeader +00081e78 T _writeCMSheader + U _writeConstructed +00082af8 T _writeContextAlgoID +00081020 t _writeContextCryptAlgoID +000828d0 T _writeMessageDigest + U _writeNull + U _writeOctetString + U _writeOctetStringHole + U _writeSequence + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(key_rw.o): + U _BN_bin2bn + U _BN_bn2bin + U _BN_num_bits +00084090 T _calculateKeyID +00083ed0 T _decodeDLValues +00083d70 T _encodeDLValues + U _getHashParameters +00083ff0 T _initKeyReadWrite + U _krnlSendMessage + U _memcmp + U _readAlgoID + U _readAlgoIDex + U _readBignumInteger16Ubits + U _readBignumInteger32 + U _readBignumTag + U _readBitStringHole + U _readConstructed + U _readGenericHole + U _readIntegerTag + U _readOctetStringHole +00082fe4 T _readPgpDlpPublicKey +00082ee4 T _readPgpRsaPublicKey +000835d8 t _readPrivateKeyDlpFunction +00083374 t _readPrivateKeyRsaFunction +000830f0 t _readPublicKeyDlpFunction +000845d0 t _readPublicKeyRsaFunction + U _readSequence + U _readShortIntegerTag +00082c00 T _readSsh1RsaPublicKey +00082d54 T _readSsh2DlpPublicKey +00082c90 T _readSsh2RsaPublicKey + U _readString32 + U _readUint32 + U _readUint32Time + U _readUniversal + U _sMemClose + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _sPeek + U _sgetc + U _signedBignumSize + U _sizeofAlgoID + U _sizeofAlgoIDex + U _sizeofBignumInteger32 + U _sizeofObject + U _sputc + U _sseek + U _strcmp + U _swrite + U _writeAlgoID + U _writeAlgoIDex + U _writeBignumInteger16Ubits + U _writeBignumInteger32 + U _writeBignumTag + U _writeBitStringHole +00083b00 T _writeFlatPublicKey + U _writeInteger + U _writeOctetStringHole +000832d0 T _writePgpDlpPublicKey +00083270 T _writePgpRsaPublicKey +00083a4c t _writePrivateKeyDlpFunction +00083684 t _writePrivateKeyRsaFunction +000847b8 t _writePublicKeyDlpFunction +0008439c t _writePublicKeyRsaFunction + U _writeSequence + U _writeShortInteger + U _writeString32 + U _writeUint32 + U _writeUint32Time + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(keyex.o): +00085c94 T _cryptExportKey +0008599c T _cryptExportKeyEx +00085994 T _cryptImportKey +00085530 T _cryptImportKeyEx +00085f0c T _cryptQueryObject + U _cryptlibToPgpAlgo + U _dynCreate + U _dynDestroy +00084b6c t _exportConventionalKey +00084e78 t _exportPublicKey + U _getObjectLength +00085da0 T _iCryptExportKeyEx +00085cdc T _iCryptImportKeyEx +000850cc t _importConventionalKey +000852e4 t _importPublicKey + U _kekReadTable + U _kekWriteTable + U _keytransReadTable + U _keytransWriteTable + U _krnlSendMessage + U _memcpy + U _memset + U _messageValueFalse + U _messageValueTrue + U _pgpReadPacketHeader + U _queryAsn1Object + U _queryPgpObject + U _readConstructed + U _readSequence + U _readShortIntegerTag + U _sMemClose + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _sizeofAlgoIDex + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(keyex_rw.o): + U _cryptlibToPgpAlgo +00086018 T _getPacketInfo + U _getStreamObjectLength +000e5288 S _kekReadTable +000e526c S _kekWriteTable +000e52c0 S _keytransReadTable +000e52a4 S _keytransWriteTable + U _krnlSendMessage + U _memset + U _pgpReadMPI + U _pgpReadPacketHeader + U _pgpToCryptlibAlgo + U _pgpWriteMPI + U _pgpWritePacketHeader +00086da8 T _queryAsn1Object +0008705c T _queryPgpObject + U _readAlgoID +00086950 t _readCmsKeytrans + U _readConstructed + U _readContextAlgoID +00086154 t _readCryptlibKek +00086bdc t _readCryptlibKeytrans + U _readGenericHole + U _readOID + U _readOctetStringHole + U _readOctetStringTag + U _readOnepassSigPacket +000872bc t _readPgpKek +000874ec t _readPgpKeytrans + U _readSequence + U _readShortIntegerTag + U _readUniversal + U _sMemDisconnect + U _sMemOpen + U _sPeek + U _sgetc + U _sigReadTable + U _sizeofContextAlgoID + U _sizeofObject + U _sputc + U _sread + U _sseek + U _swrite +00086a4c t _writeCmsKeytrans + U _writeConstructed + U _writeContextAlgoID +000863bc t _writeCryptlibKek +00086afc t _writeCryptlibKeytrans + U _writeOctetString +00086804 t _writePgpKek +00086ca8 t _writePgpKeytrans + U _writeSequence + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(misc_rw.o): + U _BN_bin2bn + U _BN_bn2bin + U _BN_high_bit + U _BN_num_bits +000d6664 s _lengthOfLength.5932 + U _memcmp + U _memmove + U _memset +000885b4 t _pgpReadLength +0008871c T _pgpReadPacketHeader +00088870 T _pgpReadShortLength +00087a18 T _pgpWriteLength +00087be8 T _pgpWritePacketHeader +000884e8 T _readBignumInteger16Ubits +00088158 T _readBignumInteger32 +00088594 T _readInteger16Ubits +000885a4 T _readInteger32 +00088584 T _readInteger32Ubits +000882f4 t _readIntegerData +00088014 T _readString32 +00087780 T _readUint32 +00087850 T _readUint32Time +00087f50 T _readUint64 +00087b14 T _readUint64Time + U _sPeek + U _sgetc +00087960 T _sizeofBignumInteger32 + U _sputc + U _sread + U _sseek + U _strlen + U _swrite +000879ac T _writeBignumInteger16Ubits +00087e7c T _writeBignumInteger32 +0008790c T _writeInteger16Ubits +00087d84 T _writeInteger32 +00087e10 T _writeInteger32Ubits +00087d00 T _writeString32 +00087808 T _writeUint32 +000878c4 T _writeUint32Time +00087c90 T _writeUint64 +00087aa4 T _writeUint64Time + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(net_cmp.o): + U _memcpy +000888c0 t _readFunction +00088ae8 T _setStreamLayerCMP + U _sioctl +00088a38 t _writeFunction + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(net_http.o): + U __DefaultRuneLocale + U ___maskrune + U ___tolower + U ___toupper + U _addMIMEchar +000d8fc8 d _allowedChars.5143 + U _atoi + U _endMIMEstate +000e56dc s _httpHeaderInfo +000e52dc s _httpStatusInfo + U _initMIMEstate +00089a5c t _readFunction +00089090 t _readHTTPStatus +00089248 t _readHeaderLines + U _retExtStreamFn + U _sMemDisconnect + U _sMemOpen +00089060 T _setStreamLayerHTTP + U _sioctl + u _sprintf$LDBLStub + U _sputc + U _strcat + U _strlen + U _strncasecmp + U _swrite +00088eac t _writeFunction +00088b18 t _writeRequestHeader + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(net_tcp.o): +000d6674 s _SOCKET_INFO_TEMPLATE + U ___dn_skipname + U ___error + U _accept + U _atoi + U _bind +0008a9c8 t _checkSocketFunction + U _checksumData + U _close +0008c488 t _closeSocketFunction + U _connect + U _dn_expand + U _enterMutex + U _exitMutex + U _fcntl +0008b110 t _findHostInfo + U _free + U _freeaddrinfo + U _getTime + U _getaddrinfo + U _gethostbyname + U _gethostname + U _getnameinfo + U _getsockopt + U _h_errno +000e5858 s _hostErrorInfo + U _listen + U _malloc + U _memcmp + U _memcpy + U _memset +0008a758 T _netEndTCP +0008a6e0 T _netInitTCP +0008a944 T _netSignalShutdown +0008a774 t _newSocket +0008b5a0 t _openSocketFunction +0008acf4 t _readSocketFunction + U _recv + U _res_query + U _select + U _send +0008ab28 T _setAccessMethodTCP + U _setsockopt + U _shutdown + U _socket +000e5778 s _socketErrorInfo +000e627c b _socketInfo + u _sprintf$LDBLStub + U _strcasecmp + U _strchr + U _strcpy +0008a6d8 t _transportOKFunction +000d7f7c s _trueValue.6161 +000d7f7c s _trueValue.6212 +0008ab88 t _writeSocketFunction + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(rndunix.o): +000d66a8 s _C.15.5311 + U ___error + U ___sF + U _abort + U _access + U _addRandomData + U _addRandomLong +0008d2cc T _checkForked + U _close + U _connect +000d8fcc d _dataSources + U _dup2 +000d9a34 d _egdSources.5170 + U _endRandomData + U _enterMutex + U _execl + U _exit + U _exitMutex +0008c5ec T _fastPoll + U _fclose + U _fcntl + U _fdopen + U _fileno + U _fork + u _fprintf$LDBLStub + U _fread +000e6284 b _gathererBufSize +000e628c b _gathererBuffer +000d9a2c d _gathererGID.5112 +000e6288 b _gathererMemID +000e6280 b _gathererProcess +000d9a30 d _gathererUID.5111 + U _getTime + U _getdtablesize + U _geteuid + U _getpagesize + U _getpid + U _getpwnam + U _getrusage + U _gettimeofday + U _initRandomData +0008d334 T _initRandomPolling + U _kill + U _krnlSendMessage + U _memcpy + U _memset + U _open +000d9a6c d _originalPID.5399 + U _pipe +000d9a44 d _procSources.5200 +000d7f88 s _quality.5162 +000d7f84 s _quality.5173 +000d7f48 s _quality.5203 + U _read + U _sched_yield + U _select + U _setregid + U _setreuid + U _setrlimit + U _shmat + U _shmctl + U _shmdt + U _shmget + U _sigaction +0008c684 T _slowPoll + U _socket + U _strcpy + U _wait4 +0008d14c T _waitforRandomCompletion + U _waitpid + U _write + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(sign.o): + U _algoAvailable +0008def0 T _checkRawSignature +0008d680 t _checkSignature +0008e770 t _checkSignatureCMS +0008f1ec t _checkSignaturePGP +0008dc38 T _checkX509signature +0008dee8 T _createRawSignature +0008d338 t _createSignature +0008def8 t _createSignatureCMS +0008edbc t _createSignaturePGP +0008d988 T _createX509signature +0008f9b8 T _cryptCheckSignature +0008f66c T _cryptCheckSignatureEx +0008f618 T _cryptCreateSignature +0008f368 T _cryptCreateSignatureEx + U _cryptlibToPgpAlgo + U _dynCreate + U _dynDestroy + U _exportAttributeToStream + U _free + U _getApproxTime + U _getObjectLength + U _getReliableTime +0008fb4c T _iCryptCheckSignatureEx +0008f9c0 T _iCryptCreateSignatureEx + U _krnlSendMessage + U _malloc + U _memcpy + U _memmove + U _memset + U _messageValueCryptUnused + U _messageValueCursorFirst + U _messageValueFalse + U _messageValueTrue + U _pgpReadPacketHeader + U _pgpWriteLength + U _pgpWritePacketHeader + U _queryAsn1Object + U _readAlgoIDex + U _readConstructed + U _readLongSequence + U _readOctetStringHole + U _readSequence + U _readShortIntegerTag + U _readUniversal + U _sMemClose + U _sMemConnect + U _sMemDisconnect + U _sMemOpen +000d66b8 s _setTag.5558 + U _sigReadTable + U _sigWriteTable + U _sizeofAlgoID + U _sizeofObject + U _sputc + U _sseek + U _swrite + U _writeAlgoID + U _writeConstructed +0008ea5c t _writePgpSigPacketHeader + U _writeSequence + U _writeSet + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(sign_rw.o): + U _getPacketInfo + U _getStreamObjectLength + U _krnlSendMessage + U _memcmp +000d9a70 d _nameString.5740 + U _pgpReadMPI + U _pgpReadShortLength + U _pgpToCryptlibAlgo + U _readAlgoID + U _readAlgoIDex + U _readBitStringHole +0008fdbc t _readCmsSignature + U _readConstructed +00090064 t _readCryptlibSignature + U _readOctetStringHole + U _readOctetStringTag +00090448 T _readOnepassSigPacket +00090520 t _readPgpSignature +0008fc38 t _readRawSignature + U _readSequence + U _readShortIntegerTag +00090240 t _readSignatureSubpackets +00090908 t _readSshSignature + U _readString32 + U _readUint32 +0008fce4 t _readX509Signature + U _sPeek + U _sgetc +000e58b0 S _sigReadTable +000e5888 S _sigWriteTable + U _sizeofAlgoID + U _sizeofContextAlgoID + U _sizeofObject + U _sputc + U _sread + U _sseek + U _strlen + U _swrite + U _writeAlgoID + U _writeBitStringHole +00090018 t _writeCmsSignature + U _writeContextAlgoID +00090140 t _writeCryptlibSignature + U _writeOctetString +00090898 t _writePgpSignature +0008fc9c t _writeRawSignature + U _writeSequence + U _writeShortInteger +00090a34 t _writeSshSignature + U _writeString32 + U _writeUint32 +0008fd68 t _writeX509Signature + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(str_file.o): + U ___error + U _access + U _chmod + U _close +00090c38 T _fileBuildCryptlibPath +0009107c T _fileClearToEOF +00090f78 T _fileErase +00090bc4 T _fileFlush +00090b50 T _fileRead +00090ab8 T _fileReadonly +00090bec T _fileSeek +00090b80 T _fileWrite + U _flock + U _fstat + U _fsync + U _ftruncate + U _getpwuid + U _getuid + U _krnlSendMessage + U _lseek + U _lstat + U _memcpy + U _memset + U _mkdir +000d66c4 s _modes.4855 + U _open + U _read +00090b00 T _sFileClose +00090d64 T _sFileOpen + U _strcat + U _strlen + U _unlink + U _utimes + U _write + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(str_mem.o): + U _memset +000911cc T _sMemClose +00091228 T _sMemConnect +00091284 T _sMemDisconnect +00091144 T _sMemOpen + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(str_net.o): + U _atoi +000912b0 t _bufferedTransportReadFunction +00091474 t _bufferedTransportWriteFunction +000915c8 t _cleanupStream +00092418 t _completeConnect +000d7f8c s _fixedTimeout.5036 + U _free + U _krnlSendMessage + U _malloc + U _memcpy + U _memmove + U _memset + U _messageValueTrue +00091a50 t _parseURL + U _retExtStreamFn +00092ad4 T _sNetConnect +000916a0 T _sNetDisconnect +000916c8 T _sNetGetErrorInfo +00092870 T _sNetListen +00092410 T _sNetParseURL + U _setAccessMethodTCP + U _setStreamLayerCMP + U _setStreamLayerHTTP + U _sioctl + U _strcasecmp + U _strcmp + U _strcpy + U _strlen + U _strncasecmp +0009158c t _transportDirectReadFunction +0009159c t _transportDirectWriteFunction +0009175c t _transportSessionConnectFunction +000915ac t _transportSessionDisconnectFunction +000915c0 t _transportSessionOKFunction +000918ec t _transportSessionReadFunction +00091828 t _transportSessionWriteFunction +000e58d8 s _urlSchemaInfo.4743 + U _waitSemaphore + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(stream.o): + U _fileFlush + U _fileRead + U _fileSeek + U _fileWrite + U _free + U _krnlSendMessage + U _malloc + U _memcpy + U _memset +00092e50 t _refillStream +00092de0 T _retExtStreamFn +000931bc T _sPeek +0009301c T _sflush +00092f38 T _sgetc +00093280 T _sioctl +000936dc T _sputc +00093528 T _sread +00093100 T _sseek + U _strcpy +00093824 T _swrite + U _vsprintf + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cmp.o): +000d6754 s _C.17.5690 +000d674c s _C.18.5698 +000e5974 s _altProtocolInfo.5703 +00094030 t _clientStartup +00094fb0 t _clientTransact +0009568c t _clientTransactWrapper + U _decodePKIUserValue +000941f8 t _getAttributeFunction +00093f7c T _hashMessageContents +00093a74 T _initMacInfo +00093c6c T _initServerAuthentMAC +00093db4 T _initServerAuthentSign + U _initSessionNetConnectInfo + U _krnlSendMessage + U _memcpy + U _memset + U _pnpPkiSession +000e5938 s _protocolInfo.5704 + U _readPkiDatagram + U _readPkiMessage +000d66d4 s _reqRespMapTbl +000939f8 T _reqToResp + U _retExtFnSession + U _sMemClose + U _sMemOpen + U _sNetConnect + U _sNetDisconnect +00094674 t _serverTransact +000945ec T _setAccessMethodCMP +0009427c t _setAttributeFunction +00093b24 t _setProtocolInfo +00094194 t _shutdownFunction + U _sioctl + U _strlen + U _writePkiDatagram + U _writePkiMessage + U _writeSequence + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cmp_rd.o): + U _checkRawSignature + U _decodePKIUserValue + U _encodePKIUserValue + U _envelopeUnwrap +000d9a74 d _failureStrings.5695 + U _hashMessageContents + U _initMacInfo + U _initServerAuthentMAC + U _initServerAuthentSign + U _krnlSendMessage + U _memcmp + U _memcpy + U _memmove + U _memset + U _readAlgoIDex + U _readBitStringHole + U _readBitStringTag + U _readCharacterString + U _readConstructed + U _readContextAlgoID + U _readOID + U _readOctetStringTag +000956f8 t _readPkiHeader +00096380 T _readPkiMessage +00095ec8 T _readPkiStatusInfo + U _readRawObjectTag + U _readSequence + U _readSet + U _readShortIntegerTag + U _readUniversal + U _retExtFnSession + U _sMemConnect + U _sMemDisconnect + U _sPeek + u _sprintf$LDBLStub + U _sseek + U _strlen + U _strncat + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(cmp_wr.o): + U _createRawSignature + U _envelopeWrap + U _exportAttributeToStream + U _exportCertToStream + U _hashMessageContents + U _krnlSendMessage + U _memcpy + U _memmove + U _reqToResp + U _sMemClose + U _sMemDisconnect + U _sMemOpen + U _sizeofAlgoID + U _sizeofObject + U _sseek + U _swrite + U _writeAlgoID + U _writeBitString + U _writeBitStringHole +00097934 t _writeCertID + U _writeConstructed + U _writeContextAlgoID +00097a60 t _writeMacInfo + U _writeNull + U _writeOctetString +00097b88 T _writePkiMessage + U _writeSequence + U _writeSet + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(ocsp.o): +000d676c s _C.7.5322 +00098b98 t _clientTransact + U _exportCertToStream + U _krnlSendMessage + U _memcmp +000e5980 s _ocspOIDselection +000e59a0 s _protocolInfo.5332 + U _readConstructed + U _readEnumeratedTag + U _readGenericHole + U _readOIDSelection + U _readPkiDatagram + U _readSequence + U _readUniversal +000d6764 s _respBadRequest +000d675c s _respIntError + U _retExtFnSession + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _sPeek +00099034 t _serverTransact +00098fdc T _setAccessMethodOCSP +00098f04 t _setAttributeFunction + U _sizeofObject + U _swrite + U _writeConstructed + U _writeEnumerated + U _writeOctetStringHole + U _writePkiDatagram + U _writeSequence + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(pnppki.o): +00099624 t _createCertRequest + U _free +000994cc t _generateKey +000e59dc s _keyInfo + U _krnlSendMessage + U _malloc + U _messageValueCursorFirst + U _messageValueCursorNext +00099790 T _pnpPkiSession + U _retExtFnSession + U _sioctl + U _strlen + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(rtcs.o): +000d6774 s _C.8.5301 +0009a6a4 t _clientTransact +000e5a18 s _envelopeOIDselection + U _envelopeSigCheck + U _envelopeSign + U _envelopeUnwrap + U _envelopeWrap + U _krnlSendMessage + U _memcmp + U _memset +000e5a78 s _protocolInfo.5311 + U _readCMSheader + U _readPkiDatagram + U _retExtFnSession + U _sMemConnect + U _sMemDisconnect +0009aaf4 t _serverTransact +0009aa9c T _setAccessMethodRTCS +0009a9c4 t _setAttributeFunction + U _writePkiDatagram + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(scep.o): + U _atoi +0009b200 t _checkAttributeFunction +0009bbb8 t _clientTransact +0009aed8 t _createScepAttributes + U _decodePKIUserValue + U _envelopeSigCheck + U _envelopeSign + U _envelopeUnwrap + U _envelopeWrap + U _free + U _isPKIUserValue +000d7f90 s _keyUsage.5238 + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _memset + U _messageValueTrue +000e5ab4 s _protocolInfo.5527 + U _readPkiDatagram + U _retExtFnSession +0009b2bc t _serverTransact +0009b258 T _setAccessMethodSCEP +0009b0f8 t _setAttributeFunction + U _sioctl + U _strlen + U _writePkiDatagram + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(ssh.o): + U _attributeCopy +0009c804 t _completeStartup +0009c35c T _encodeString +0009c3dc t _getAttributeFunction + U _initSSH1processing + U _initSSH2processing +0009c570 T _initSecurityContexts + U _krnlSendMessage + U _memcmp + U _memcpy + U _memset + U _retExtFnSession + U _sNetGetErrorInfo + U _sNetParseURL +0009d0ac t _serverStartup +0009c4e8 T _setAccessMethodSSH +0009c430 t _setAttributeFunction + U _sioctl + U _sread + U _strlen + U _strstr + U _swrite + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(ssh1.o): + U _algoAvailable +0009ee34 t _beginClientHandshake +0009dc20 t _beginServerHandshake +0009e934 t _completeClientHandshake +0009f33c t _completeServerHandshake +000d677c s _crc32table + U _encodeString +0009d968 t _exchangeClientKeys +0009f590 t _exchangeServerKeys + U _getHashParameters +0009d5ec T _initSSH1processing + U _initSecurityContexts +0009d364 t _initSecurityInfoSSH1 +000d6b7c s _iv.5166 +000d7f94 s _keyLength.5687 + U _krnlSendMessage + U _memcmp + U _memcpy + U _memmove + U _memset +0009dfdc t _processBodyFunction +0009d134 t _processPublickeyData +000d6b9c s _protocolInfo.6008 + U _readFixedHeader +0009d504 t _readHeaderFunction +0009e42c t _readPacketSSH1 + U _retExtFnSession + U _sNetDisconnect + U _sNetGetErrorInfo +0009d698 t _sendPacketSsh1 +0009d5e4 t _shutdownFunction + U _sread + U _strlen + U _swrite +0009df5c t _writeDataFunction + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(ssh2.o): + U _algoAvailable +000e5b20 s _algoStringCoprTbl +000e5b48 s _algoStringEncrTblClient +000e5b80 s _algoStringEncrTblServer +000e5bb0 s _algoStringKeyexTbl +000e5b30 s _algoStringMACTbl +000e5bc8 s _algoStringMapTbl.5135 +000e5b08 s _algoStringPubkeyTbl +000e5af0 s _algoStringUserauthentTbl +000a0dac T _completeKeyex +000d6f60 s _dh1024SPKI +000d6e88 s _dh1536SSH +000d6d70 s _dh2048SSH +000d6bd8 s _dh3072SSH +0009fea4 T _encodeMPI + U _encodeString +000d7088 s _errorMap.5502 + U _getAddressAndPort +0009fd38 T _getAlgoID +0009fa6c t _getAlgoIDEx +000a01b4 t _getDisconnectInfo + U _getHashParameters +0009ffd4 T _hashAsMPI +0009ff20 T _hashAsString +0009f8a0 T _initDHcontext + U _initSSH2clientProcessing +000a0d0c T _initSSH2processing + U _initSSH2serverProcessing + U _initSecurityContexts +000a2224 T _initSecurityInfo +000d9af4 d _invalidRequests.5877 + U _krnlSendMessage +000a0078 t _macPayload + U _memcmp + U _memcpy + U _memmove + U _memset +000a1c14 t _processBodyFunction + U _processChannelOpen +000a117c T _processHello +000a17b4 T _processRequest +000d70b8 s _protocolInfo.6266 +0009fdb8 T _putAlgoID + U _readFixedHeader +000a0ad4 t _readHeaderFunction +000a034c T _readPacketSSH2 + U _retExtFnSession + U _sNetDisconnect + U _sNetGetErrorInfo +000a0a58 T _sendPacketSSH2 +000a1fd0 t _shutdownFunction + U _sioctl + U _sread + U _strcat + U _strlen + U _swrite +000d9ae4 d _validRequests.5878 +000a0854 T _wrapPacket +000a1f0c t _writeDataFunction + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(ssh2_cli.o): +000a29cc t _beginClientHandshake +000a3420 t _completeClientHandshake + U _completeKeyex + U _encodeMPI + U _encodeString +000a2f54 t _exchangeClientKeys + U _getAlgoID + U _getHashParameters + U _hashAsString + U _iCryptCheckSignatureEx + U _iCryptCreateSignatureEx + U _initDHcontext +000a3ba8 T _initSSH2clientProcessing + U _initSecurityInfo + U _krnlSendMessage + U _memcmp + U _memcpy + U _memmove + U _memset + U _processHello + U _putAlgoID + U _readPacketSSH2 + U _retExtFnSession + U _sNetGetErrorInfo + U _sNetParseURL + U _sendPacketSSH2 + U _strlen + U _swrite + U _wrapPacket + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(ssh2_svr.o): + U _algoAvailable +000d7100 s _algoEncrList +000d7118 s _algoKeyexList +000d70f4 s _algoMACList +000d9b00 d _algoStringCoprList +000e5c30 s _algoStringMapTbl.4959 +000e5c98 s _algoStringPubkeyDSATbl.5177 +000e5ca8 s _algoStringPubkeyRSATbl.5176 +000d9afc d _algoStringUserauthentList +000a4158 t _beginServerHandshake + U _completeKeyex +000a4884 t _completeServerHandshake + U _encodeMPI + U _encodeString +000a46a4 t _exchangeServerKeys +000a3d78 T _getAddressAndPort + U _hashAsString + U _iCryptCreateSignatureEx + U _initDHcontext +000a4d00 T _initSSH2serverProcessing + U _initSecurityInfo + U _krnlSendMessage + U _memcmp + U _memcpy + U _memmove + U _memset +000a3e84 T _processChannelOpen + U _processHello + U _processRequest + U _putAlgoID +000a3be0 t _putAlgoList + U _readPacketSSH2 + U _retExtFnSession + U _sendPacketSSH2 + U _sprintf + U _strlen + U _wrapPacket + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(ssl.o): +000a6408 t _abortStartup + U _addSessionCacheEntry +000e5cb8 s _alertInfo.5525 +000d7168 s _changeCipherSpecTemplate +000a5a38 T _checkPacketHeader +000a84a0 t _clientStartup +000d7120 s _closeAlertTemplate +000a73fc t _commonStartup +000a5b28 t _completeSSLDualMAC +000a6078 T _createSharedMasterSecret + U _decodePKIUserValue +000a4e90 t _decryptData + U _deleteSessionCacheEntry +000a5410 T _dualMacData + U _findSessionCacheEntryID +000d7180 s _finishedTemplate +000a5d80 t _getAttributeFunction +000d71c8 s _handshakeFailAlertTemplate + U _iCryptCheckSignatureEx + U _iCryptCreateSignatureEx +000a4d38 T _initCiphersuiteInfo + U _initSSLclientProcessing + U _initSSLserverProcessing + U _krnlSendMessage +000a5004 t _macDataSSL +000a5278 t _macDataTLS + U _memcmp + U _memcpy + U _memmove + U _memset + U _messageValueCursorFirst + U _messageValueCursorNext + U _messageValueFalse + U _messageValueTrue +000a5dec t _processBodyFunction +000a579c T _processCertVerify +000a598c T _processVersionInfo +000d7210 s _protocolInfo.6088 + U _readFixedHeader +000a7070 t _readHandshakeCompletionData +000a6b38 t _readHeaderFunction +000a65cc t _readPacketHeader +000a6ce4 T _readPacketSSL + U _retExtFnSession + U _sNetDisconnect + U _sNetGetErrorInfo +000a84a8 t _serverStartup +000a5fe0 T _setAccessMethodSSL +000a6280 t _setAttributeFunction +000a8504 t _shutdownFunction + U _sioctl + U _sread + U _strcat + U _swrite + U _waitSemaphore +000a54b8 t _wrapData +000a5a14 T _wrapHandshakePacket +000a5f7c t _writeDataFunction +000a561c T _writeSSLCertChain + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(ssl_cli.o): + U _algoAvailable +000a8614 T _beginClientHandshake + U _checkPacketHeader + U _createSharedMasterSecret + U _dualMacData +000a8bfc T _exchangeClientKeys + U _initCiphersuiteInfo +000a937c T _initSSLclientProcessing + U _krnlSendMessage + U _memcmp + U _memcpy + U _memset +000d7254 s _noCertAlertSSLTemplate +000d724c s _noCertTLSTemplate + U _processCertVerify + U _processVersionInfo + U _readPacketSSL + U _retExtFnSession + U _sNetGetErrorInfo +000d725c s _serverHelloDoneTemplate + U _swrite + U _wrapHandshakePacket + U _writeSSLCertChain + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(ssl_svr.o): +000d7274 s _SESSIONCACHE_INDEX_TEMPLATE +000aa7dc T _addSessionCacheEntry + U _algoAvailable +000a9db8 T _beginServerHandshake + U _checkPacketHeader + U _checksumData +000a93a8 T _deleteSessionCacheEntry + U _dualMacData +000a9578 T _endSessionCache + U _enterMutex +000a95fc T _exchangeServerKeys + U _exitMutex +000aa7f4 T _findSessionCacheEntryID + U _free + U _getHashParameters + U _getTime +000a9a6c t _handleSessionCache +000e6290 b _hashFunction.5077 + U _initCiphersuiteInfo +000a9a40 T _initSSLserverProcessing +000a9480 T _initSessionCache + U _krnlMemalloc + U _krnlMemfree + U _krnlSendMessage + U _malloc + U _memcmp + U _memcpy + U _memset + U _processCertVerify + U _processVersionInfo + U _readPacketSSL + U _retExtFnSession + U _sNetGetErrorInfo +000d7264 s _serverCertRequestTemplate +000d7260 s _serverHelloDoneTemplate +000e6294 b _sesionCacheUniqueID +000e629c b _sessionCacheData +000e62a0 b _sessionCacheIndex +000e6298 b _sessionCacheLastEntry + U _swrite + U _wrapHandshakePacket + U _writeSSLCertChain + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(tsp.o): +000e5e5c s _altProtocolInfo.5671 + U _attributeCopy +000aaeb0 t _checkAttributeFunction +000aa804 t _clientTransact +000d7f98 s _contentType.5273 + U _dynCreate + U _dynDestroy +000aac94 t _getAttributeFunction + U _getReliableTime + U _krnlSendMessage + U _memcmp + U _memcpy + U _memmove + U _memset + U _messageValueFalse +000d7f80 s _minBufferSize.5272 +000e5e20 s _protocolInfo.5672 + U _readBooleanTag + U _readConstructed + U _readOctetStringHole + U _readPkiDatagram + U _readPkiStatusInfo + U _readRawObjectTag + U _readSequence + U _readShortIntegerTag + U _readUniversal +000d7298 s _respBadData +000d72a8 s _respBadExtension +000d72bc s _respBadGeneric + U _retExtFnSession + U _sMemConnect + U _sMemDisconnect + U _sMemOpen + U _sNetGetErrorInfo + U _sPeek +000aafc8 t _serverTransact +000aaf5c T _setAccessMethodTSP +000aae08 t _setAttributeFunction + U _sizeofAlgoID + U _sizeofObject + U _sread + U _sseek + U _swrite + U _writeBoolean + U _writeGeneralizedTime + U _writeInteger + U _writeMessageDigest + U _writePkiDatagram + U _writeSequence + U _writeShortInteger + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(adler32.o): +000ab874 T _adler32 + +/opt/local/lib/libcl.dylib(deflate.o): + U __dist_code + U __length_code + U __tr_align + U __tr_flush_block + U __tr_init + U __tr_stored_block + U _adler32 +000e5e68 s _configuration_table +000ad980 T _deflate +000ac6bc T _deflateCopy +000aba14 T _deflateEnd +000ac1f0 T _deflateInit2_ +000ac6a0 T _deflateInit_ +000adee4 T _deflateParams +000abc98 T _deflateReset +000abb50 T _deflateSetDictionary +000c1844 S _deflate_copyright +000acd1c t _deflate_fast +000ad278 t _deflate_slow +000ac988 t _deflate_stored +000abfd0 t _fill_window +000abdf0 t _longest_match + U _memcpy + U _memset +000d9b04 d _my_version.4220 + U _z_errmsg + U _zcalloc + U _zcfree + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(infblock.o): +000d72d0 s _border +000ae0a8 T _inflate_blocks +000aef34 T _inflate_blocks_free +000aede8 T _inflate_blocks_new +000adfe4 T _inflate_blocks_reset +000aedd4 T _inflate_blocks_sync_point + U _inflate_codes + U _inflate_codes_free + U _inflate_codes_new + U _inflate_flush + U _inflate_mask +000aed90 T _inflate_set_dictionary + U _inflate_trees_bits + U _inflate_trees_dynamic + U _inflate_trees_fixed + U _memcpy + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(infcodes.o): +000af0a4 T _inflate_codes +000af990 T _inflate_codes_free +000af034 T _inflate_codes_new + U _inflate_fast + U _inflate_flush + U _inflate_mask + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(inffast.o): +000af9a8 T _inflate_fast + U _inflate_mask + +/opt/local/lib/libcl.dylib(inflate.o): + U _adler32 +000aff58 T _inflate +000afed4 T _inflateEnd +000b07c0 T _inflateInit2_ +000b09fc T _inflateInit_ +000afe58 T _inflateReset +000b0540 T _inflateSetDictionary +000b0628 T _inflateSync +000b05fc T _inflateSyncPoint + U _inflate_blocks + U _inflate_blocks_free + U _inflate_blocks_new + U _inflate_blocks_reset + U _inflate_blocks_sync_point + U _inflate_set_dictionary +000d731c s _mark.2280 + U _zcalloc + U _zcfree + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(inftrees.o): +000d7320 s _cpdext +000d7398 s _cpdist +000d748c s _cplens +000d7410 s _cplext +000dac08 d _fixed_bd +000dac0c d _fixed_bl +000d9b08 d _fixed_td +000d9c08 d _fixed_tl +000b0a0c t _huft_build +000c1994 S _inflate_copyright +000b0fe4 T _inflate_trees_bits +000b10e4 T _inflate_trees_dynamic +000b12cc T _inflate_trees_fixed + +/opt/local/lib/libcl.dylib(infutil.o): +000b1314 T _inflate_flush +000dac10 D _inflate_mask + U _memcpy + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(trees.o): +000d7608 S __dist_code +000d7508 S __length_code +000b28f0 T __tr_align +000b2c48 T __tr_flush_block +000b269c T __tr_init +000b2770 T __tr_stored_block +000b25ac T __tr_tally +000d7d14 s _base_dist +000d7e04 s _base_length +000d7d00 s _bl_order +000b1594 t _build_tree +000b2154 t _compress_block +000d7eec s _extra_blbits +000d7d8c s _extra_dbits +000d7e78 s _extra_lbits +000b148c t _pqdownheap +000b1be4 t _send_tree +000dac54 d _static_bl_desc +000dac68 d _static_d_desc +000d7808 s _static_dtree +000dac7c d _static_l_desc +000d7880 s _static_ltree + +/opt/local/lib/libcl.dylib(zutil.o): + U _calloc + U _free +000b353c T _zError +000dac90 D _z_errmsg +000b3564 T _zcalloc +000b3570 T _zcfree +000b3520 T _zlibVersion + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(_umoddi3.o): +000d7f9c s EH_frame1 +000b3578 t ___umoddi3 +000d7fb0 s ___umoddi3.eh + +/opt/local/lib/libcl.dylib(s_sprintf.o): + u ___stub_getrealaddr +000e62a4 b _funcptr +000b3918 t _sprintf$LDBLStub + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(s_vsprintf.o): + u ___stub_getrealaddr +000e62a8 b _funcptr +000b39c4 t _vsprintf$LDBLStub + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(s_fprintf.o): + u ___stub_getrealaddr +000b3a70 t _fprintf$LDBLStub +000e62ac b _funcptr + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(getrealaddr.o): + U _NSAddressOfSymbol + U _NSIsSymbolNameDefinedWithHint + U _NSLookupAndBindSymbolWithHint +000b3b1c t ___stub_getrealaddr + U _strcpy + U _strlen + u dyld_stub_binding_helper + +/opt/local/lib/libcl.dylib(link editor): +00000000 t __mh_dylib_header \ No newline at end of file diff --git a/db/mysql/ffi/ffi.factor b/db/mysql/ffi/ffi.factor new file mode 100644 index 0000000..98fd0b3 --- /dev/null +++ b/db/mysql/ffi/ffi.factor @@ -0,0 +1,25 @@ +! Copyright (C) 2007 Berlin Brown, 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +! Adapted from mysql.h and mysql.c +! Tested with MySQL version - 5.0.24a +USING: alien alien.syntax combinators kernel system ; +IN: db.mysql.ffi + +<< "mysql" { + { [ os winnt? ] [ "libmySQL.dll" stdcall ] } + { [ os macosx? ] [ "libmysqlclient.14.dylib" cdecl ] } + { [ os unix? ] [ "libmysqlclient.so.14" cdecl ] } +} cond add-library >> + +LIBRARY: mysql + +FUNCTION: void* mysql_init ( void* mysql ) ; +FUNCTION: char* mysql_error ( void* mysql ) ; +FUNCTION: void* mysql_real_connect ( void* mysql, char* host, char* user, char* passwd, char* db, int port, char* unixsocket, long clientflag ) ; +FUNCTION: void mysql_close ( void* sock ) ; +FUNCTION: int mysql_query ( void* mysql, char* q ) ; +FUNCTION: void* mysql_use_result ( void* mysql ) ; +FUNCTION: void mysql_free_result ( void* result ) ; +FUNCTION: char** mysql_fetch_row ( void* result ) ; +FUNCTION: int mysql_num_fields ( void* result ) ; +FUNCTION: ulong mysql_affected_rows ( void* mysql ) ; diff --git a/db/mysql/lib/lib.factor b/db/mysql/lib/lib.factor new file mode 100644 index 0000000..6c16248 --- /dev/null +++ b/db/mysql/lib/lib.factor @@ -0,0 +1,78 @@ +! Copyright (C) 2007 Berlin Brown, 2008 Doug Coleman. +! See http://factorcode.org/license.txt for license. +! Adapted from mysql.h and mysql.c +! Tested with MySQL version - 5.0.24a +USING: kernel alien io prettyprint sequences +namespaces arrays math db.mysql.ffi system accessors ; +IN: db.mysql.lib + +SYMBOL: my-conn + +TUPLE: mysql-db handle host user password db port ; +TUPLE: mysql-statement ; +TUPLE: mysql-result-set ; + +: new-mysql ( -- conn ) + f mysql_init ; + +: mysql-error ( mysql -- ) + [ mysql_error throw ] when* ; + +! : mysql-connect ( mysql-connection -- ) + ! new-mysql over set-mysql-db-handle + ! dup { + ! mysql-db-handle + ! mysql-db-host + ! mysql-db-user + ! mysql-db-password + ! mysql-db-db + ! mysql-db-port + ! } get-slots f 0 mysql_real_connect mysql-error ; + +! ========================================================= +! Low level mysql utility definitions +! ========================================================= + +: (mysql-query) ( mysql-connection query -- ret ) + >r db-handle>> r> mysql_query ; + +! : (mysql-result) ( mysql-connection -- ret ) + ! [ mysql-db-handle mysql_use_result ] keep + ! [ set-mysql-connection-resulthandle ] keep ; + +! : (mysql-affected-rows) ( mysql-connection -- n ) + ! mysql-connection-mysqlconn mysql_affected_rows ; + +! : (mysql-free-result) ( mysql-connection -- ) + ! mysql-connection-resulthandle drop ; + +! : (mysql-row) ( mysql-connection -- row ) + ! mysql-connection-resulthandle mysql_fetch_row ; + +! : (mysql-num-cols) ( mysql-connection -- n ) + ! mysql-connection-resulthandle mysql_num_fields ; + +! : mysql-char*-nth ( index object -- str ) + ! ! Utility based on 'char*-nth' to perform an additional sanity check on the value + ! ! extracted from the array of strings. + ! void*-nth [ alien>char-string ] [ "" ] if* ; + +! : mysql-row>seq ( object n -- seq ) + ! [ swap mysql-char*-nth ] map-with ; + +! : (mysql-result>seq) ( seq -- seq ) + ! my-conn get (mysql-row) dup [ + ! my-conn get (mysql-num-cols) mysql-row>seq + ! over push + ! (mysql-result>seq) + ! ] [ drop ] if + ! ! Perform needed cleanup on fetched results + ! my-conn get (mysql-free-result) ; + +! : mysql-query ( query -- ret ) + ! >r my-conn get r> (mysql-query) drop + ! my-conn get (mysql-result) ; + +! : mysql-command ( query -- n ) + ! mysql-query drop + ! my-conn get (mysql-affected-rows) ; diff --git a/db/mysql/mysql.factor b/db/mysql/mysql.factor new file mode 100644 index 0000000..1767bf3 --- /dev/null +++ b/db/mysql/mysql.factor @@ -0,0 +1,51 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for license. +USING: alien continuations destructors io kernel prettyprint +sequences db db.mysql.ffi ; +IN: db.mysql + +TUPLE: mysql-db handle host user password db port ; +TUPLE: mysql-statement ; +TUPLE: mysql-result-set ; + +M: mysql-db db-open ( mysql-db -- ) + ; + +M: mysql-db dispose ( mysql-db -- ) + mysql-db-handle mysql_close ; + +M: mysql-db ( str in out -- statement ) + 3drop f ; + +M: mysql-db ( str in out -- statement ) + 3drop f ; + +M: mysql-statement prepare-statement ( statement -- ) + drop ; + +M: mysql-statement bind-statement* ( statement -- ) + drop ; + +M: mysql-statement query-results ( query -- result-set ) + drop f ; + +M: mysql-result-set #rows ( result-set -- n ) + drop 0 ; + +M: mysql-result-set #columns ( result-set -- n ) + drop 0 ; + +M: mysql-result-set row-column ( result-set n -- obj ) + 2drop f ; + +M: mysql-result-set advance-row ( result-set -- ) + drop ; + +M: mysql-db begin-transaction ( -- ) + ; + +M: mysql-db commit-transaction ( -- ) + ; + +M: mysql-db rollback-transaction ( -- ) + ; diff --git a/dns/cache/nx/nx.factor b/dns/cache/nx/nx.factor new file mode 100644 index 0000000..292e5f1 --- /dev/null +++ b/dns/cache/nx/nx.factor @@ -0,0 +1,35 @@ + +USING: kernel assocs locals combinators + math math.functions system unicode ; + +IN: dns.cache.nx + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: nx-cache ( -- table ) H{ } ; + +: nx-cache-at ( name -- time ) >lower nx-cache at ; +: nx-cache-delete-at ( name -- ) >lower nx-cache delete-at ; +: nx-cache-set-at ( time name -- ) >lower nx-cache set-at ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: now ( -- seconds ) millis 1000.0 / round >integer ; + +:: non-existent-name? ( NAME -- ? ) + [let | TIME [ NAME nx-cache-at ] | + { + { [ TIME f = ] [ f ] } + { [ TIME now <= ] [ NAME nx-cache-delete-at f ] } + { [ t ] [ t ] } + } + cond + ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: cache-non-existent-name ( NAME TTL -- ) + [let | TIME [ TTL now + ] | TIME NAME nx-cache-set-at ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/dns/cache/rr/rr.factor b/dns/cache/rr/rr.factor new file mode 100644 index 0000000..e2ce523 --- /dev/null +++ b/dns/cache/rr/rr.factor @@ -0,0 +1,65 @@ + +USING: kernel sequences assocs sets locals combinators + accessors system math math.functions unicode prettyprint + combinators.smart dns ; + +IN: dns.cache.rr + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: time data ; + +: now ( -- seconds ) millis 1000.0 / round >integer ; + +: expired? ( -- ? ) time>> now <= ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: make-cache-key ( obj -- key ) + [ [ name>> >lower ] [ type>> ] [ class>> ] tri ] output>array ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cache ( -- table ) H{ } ; + +: cache-at ( obj -- ent ) make-cache-key cache at ; +: cache-delete ( obj -- ) make-cache-key cache delete-at ; +: cache-set-at ( ent obj -- ) make-cache-key cache set-at ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: cache-get ( OBJ -- rrs/f ) + [let | ENT [ OBJ cache-at ] | + { + { [ ENT f = ] [ f ] } + { [ ENT expired? ] [ OBJ cache-delete f ] } + { + [ t ] + [ + [let | NAME [ OBJ name>> ] + TYPE [ OBJ type>> ] + CLASS [ OBJ class>> ] + TTL [ ENT time>> now - ] | + ENT data>> + [| RDATA | T{ rr f NAME TYPE CLASS TTL RDATA } ] + map + ] + ] + } + } + cond + ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: cache-add ( RR -- ) + [let | ENT [ RR cache-at ] + TIME [ RR ttl>> now + ] + RDATA [ RR rdata>> ] | + { + { [ ENT f = ] [ T{ f TIME V{ RDATA } } RR cache-set-at ] } + { [ ENT expired? ] [ RR cache-delete RR cache-add ] } + { [ t ] [ TIME ENT time<< RDATA ENT data>> adjoin ] } + } + cond + ] ; diff --git a/dns/dns.factor b/dns/dns.factor new file mode 100644 index 0000000..a51347f --- /dev/null +++ b/dns/dns.factor @@ -0,0 +1,501 @@ + +USING: kernel byte-arrays combinators strings arrays sequences splitting + grouping + math math.functions math.parser random + destructors + io io.binary io.sockets io.encodings.binary + accessors + combinators.smart + assocs + ; + +IN: dns + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: query name type class ; + +TUPLE: rr name type class ttl rdata ; + +TUPLE: hinfo cpu os ; + +TUPLE: mx preference exchange ; + +TUPLE: soa mname rname serial refresh retry expire minimum ; + +TUPLE: message + id qr opcode aa tc rd ra z rcode + question-section + answer-section + authority-section + additional-section ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: random-id ( -- id ) 2 16 ^ random ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! TYPE +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOLS: A NS MD MF CNAME SOA MB MG MR NULL WKS PTR HINFO MINFO MX TXT AAAA ; + +: type-table ( -- table ) + { + { A 1 } + { NS 2 } + { MD 3 } + { MF 4 } + { CNAME 5 } + { SOA 6 } + { MB 7 } + { MG 8 } + { MR 9 } + { NULL 10 } + { WKS 11 } + { PTR 12 } + { HINFO 13 } + { MINFO 14 } + { MX 15 } + { TXT 16 } + { AAAA 28 } + } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! CLASS +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOLS: IN CS CH HS ; + +: class-table ( -- table ) + { + { IN 1 } + { CS 2 } + { CH 3 } + { HS 4 } + } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! OPCODE +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOLS: QUERY IQUERY STATUS ; + +: opcode-table ( -- table ) + { + { QUERY 0 } + { IQUERY 1 } + { STATUS 2 } + } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! RCODE +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOLS: NO-ERROR FORMAT-ERROR SERVER-FAILURE NAME-ERROR NOT-IMPLEMENTED + REFUSED ; + +: rcode-table ( -- table ) + { + { NO-ERROR 0 } + { FORMAT-ERROR 1 } + { SERVER-FAILURE 2 } + { NAME-ERROR 3 } + { NOT-IMPLEMENTED 4 } + { REFUSED 5 } + } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: ( -- message ) + message new + random-id >>id + 0 >>qr + QUERY >>opcode + 0 >>aa + 0 >>tc + 1 >>rd + 0 >>ra + 0 >>z + NO-ERROR >>rcode + { } >>question-section + { } >>answer-section + { } >>authority-section + { } >>additional-section ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: ip->ba ( ip -- ba ) "." split [ string>number ] map >byte-array ; + +: ipv6->ba ( ip -- ba ) ":" split [ hex> ] map [ 2 >be ] map concat ; + +: label->ba ( label -- ba ) [ >byte-array ] [ length ] bi prefix ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: uint8->ba ( n -- ba ) 1 >be ; +: uint16->ba ( n -- ba ) 2 >be ; +: uint32->ba ( n -- ba ) 4 >be ; +: uint64->ba ( n -- ba ) 8 >be ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: dn->ba ( dn -- ba ) "." split [ label->ba ] map concat ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: query->ba ( query -- ba ) + [ + { + [ name>> dn->ba ] + [ type>> type-table at uint16->ba ] + [ class>> class-table at uint16->ba ] + } cleave + ] output>array concat ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: hinfo->ba ( rdata -- ba ) + [ cpu>> label->ba ] + [ os>> label->ba ] + bi append ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: mx->ba ( rdata -- ba ) + [ preference>> uint16->ba ] + [ exchange>> dn->ba ] + bi append ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: soa->ba ( rdata -- ba ) + [ + { + [ mname>> dn->ba ] + [ rname>> dn->ba ] + [ serial>> uint32->ba ] + [ refresh>> uint32->ba ] + [ retry>> uint32->ba ] + [ expire>> uint32->ba ] + [ minimum>> uint32->ba ] + } cleave + ] output>array concat ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: rdata->ba ( type rdata -- ba ) + swap + { + { CNAME [ dn->ba ] } + { HINFO [ hinfo->ba ] } + { MX [ mx->ba ] } + { NS [ dn->ba ] } + { PTR [ dn->ba ] } + { SOA [ soa->ba ] } + { A [ ip->ba ] } + } + case ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: rr->ba ( rr -- ba ) + [ + { + [ name>> dn->ba ] + [ type>> type-table at uint16->ba ] + [ class>> class-table at uint16->ba ] + [ ttl>> uint32->ba ] + [ + [ type>> ] [ rdata>> ] bi rdata->ba + [ length uint16->ba ] [ ] bi append + ] + } cleave + ] output>array concat ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: header-bits-ba ( message -- ba ) + [ + { + [ qr>> 15 shift ] + [ opcode>> opcode-table at 11 shift ] + [ aa>> 10 shift ] + [ tc>> 9 shift ] + [ rd>> 8 shift ] + [ ra>> 7 shift ] + [ z>> 4 shift ] + [ rcode>> rcode-table at 0 shift ] + } cleave + ] sum-outputs uint16->ba ; + +: message->ba ( message -- ba ) + [ + { + [ id>> uint16->ba ] + [ header-bits-ba ] + [ question-section>> length uint16->ba ] + [ answer-section>> length uint16->ba ] + [ authority-section>> length uint16->ba ] + [ additional-section>> length uint16->ba ] + [ question-section>> [ query->ba ] map concat ] + [ answer-section>> [ rr->ba ] map concat ] + [ authority-section>> [ rr->ba ] map concat ] + [ additional-section>> [ rr->ba ] map concat ] + } cleave + ] output>array concat ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-single ( ba i -- n ) at ; +: get-double ( ba i -- n ) dup 2 + subseq be> ; +: get-quad ( ba i -- n ) dup 4 + subseq be> ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: label-length ( ba i -- length ) get-single ; + +: skip-label ( ba i -- ba i ) 2dup label-length + 1 + ; + +: null-label? ( ba i -- ? ) get-single 0 = ; + +: get-label ( ba i -- label ) [ 1 + ] [ skip-label nip ] 2bi subseq >string ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: bit-test ( a b -- ? ) bitand 0 = not ; + +: pointer? ( ba i -- ? ) get-single 0b11000000 bit-test ; + +: pointer ( ba i -- val ) get-double 0b0011111111111111 bitand ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: skip-name ( ba i -- ba i ) + { + { [ 2dup null-label? ] [ 1 + ] } + { [ 2dup pointer? ] [ 2 + ] } + { [ t ] [ skip-label skip-name ] } + } + cond ; + +: get-name ( ba i -- name ) + { + { [ 2dup null-label? ] [ 2drop "" ] } + { [ 2dup pointer? ] [ dupd pointer get-name ] } + { + [ t ] + [ + [ get-label ] + [ skip-label get-name ] + 2bi + "." glue + ] + } + } + cond ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-query ( ba i -- query ) + [ get-name ] + [ + skip-name + [ 0 + get-double type-table value-at ] + [ 2 + get-double class-table value-at ] + 2bi + ] + 2bi query boa ; + +: skip-query ( ba i -- ba i ) skip-name 4 + ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-mx ( ba i -- mx ) [ get-double ] [ 2 + get-double ] 2bi mx boa ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-soa ( ba i -- soa ) + { + [ get-name ] + [ skip-name get-name ] + [ + skip-name + skip-name + { + [ 0 + get-quad ] + [ 4 + get-quad ] + [ 8 + get-quad ] + [ 12 + get-quad ] + [ 16 + get-quad ] + } + 2cleave + ] + } + 2cleave soa boa ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-ip ( ba i -- ip ) dup 4 + subseq >array [ number>string ] map "." join ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-ipv6 ( ba i -- ip ) + dup 16 + subseq 2 group [ be> >hex ] map ":" join ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-rdata ( ba i type -- rdata ) + { + { CNAME [ get-name ] } + { NS [ get-name ] } + { PTR [ get-name ] } + { MX [ get-mx ] } + { SOA [ get-soa ] } + { A [ get-ip ] } + { AAAA [ get-ipv6 ] } + } + case ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-rr ( ba i -- rr ) + [ get-name ] + [ + skip-name + { + [ 0 + get-double type-table value-at ] + [ 2 + get-double class-table value-at ] + [ 4 + get-quad ] + [ [ 10 + ] [ get-double type-table value-at ] 2bi get-rdata ] + } + 2cleave + ] + 2bi rr boa ; + +: skip-rr ( ba i -- ba i ) skip-name 8 + 2dup get-double + 2 + ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-question-section ( ba i count -- seq ba i ) + [ drop [ skip-query ] [ get-query ] 2bi ] map -rot ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: get-rr-section ( ba i count -- seq ba i ) + [ drop [ skip-rr ] [ get-rr ] 2bi ] map -rot ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: >> ( x n -- y ) neg shift ; + +: get-header-bits ( ba i -- qr opcode aa tc rd ra z rcode ) + get-double + { + [ 15 >> 0b1 bitand ] + [ 11 >> 0b111 bitand opcode-table value-at ] + [ 10 >> 0b1 bitand ] + [ 9 >> 0b1 bitand ] + [ 8 >> 0b1 bitand ] + [ 7 >> 0b1 bitand ] + [ 4 >> 0b111 bitand ] + [ 0b1111 bitand rcode-table value-at ] + } + cleave ; + +: parse-message ( ba -- message ) + 0 + { + [ get-double ] + [ 2 + get-header-bits ] + [ + 4 + + { + [ 8 + ] + [ 0 + get-double ] + [ 2 + get-double ] + [ 4 + get-double ] + [ 6 + get-double ] + } + 2cleave + { + [ get-question-section ] + [ get-rr-section ] + [ get-rr-section ] + [ get-rr-section ] + } spread + 2drop + ] + } + 2cleave message boa ; + +: ba->message ( ba -- message ) parse-message ; + +: with-message-bytes ( ba quot -- ) [ ba->message ] dip call message->ba ; inline + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: send-receive-udp ( ba server -- ba ) + f 0 + [ + [ send ] [ receive drop ] bi + ] + with-disposal ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: send-receive-tcp ( ba server -- ba ) + [ dup length 2 >be prepend ] [ ] bi* + binary + [ + write flush + 2 read be> read + ] + with-client ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: >dns-inet4 ( obj -- inet4 ) + dup string? + [ 53 ] + [ ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: ask-server ( message server -- message ) + [ message->ba ] [ >dns-inet4 ] bi* + 2dup + send-receive-udp parse-message + dup tc>> 1 = + [ drop send-receive-tcp parse-message ] + [ nip nip ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: dns-servers ( -- seq ) V{ } ; + +: dns-server ( -- server ) dns-servers random ; + +: ask ( message -- message ) dns-server ask-server ; + +: query->message ( query -- message ) swap 1array >>question-section ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: message-query ( message -- query ) question-section>> first ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +ERROR: name-error name ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: fully-qualified ( name -- name ) + { + { [ dup empty? ] [ "." append ] } + { [ dup last CHAR: . = ] [ ] } + { [ t ] [ "." append ] } + } + cond ; diff --git a/dns/forwarding/forwarding.factor b/dns/forwarding/forwarding.factor new file mode 100644 index 0000000..4b7db30 --- /dev/null +++ b/dns/forwarding/forwarding.factor @@ -0,0 +1,124 @@ + +USING: kernel sequences combinators accessors locals random + combinators.short-circuit + io.sockets + dns dns.util dns.cache.rr dns.cache.nx + dns.resolver ; + +IN: dns.forwarding + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: query->rrs ( QUERY -- rrs/f ) + [let | RRS [ QUERY cache-get ] | + RRS + [ RRS ] + [ + [let | NAME [ QUERY name>> ] + TYPE [ QUERY type>> ] + CLASS [ QUERY class>> ] | + + [let | RRS/CNAME [ T{ query f NAME CNAME CLASS } cache-get ] | + + RRS/CNAME f = + [ f ] + [ + [let | RR/CNAME [ RRS/CNAME first ] | + + [let | REAL-NAME [ RR/CNAME rdata>> ] | + + [let | RRS [ + T{ query f REAL-NAME TYPE CLASS } query->rrs + ] | + + RRS + [ RRS/CNAME RRS append ] + [ f ] + if + ] ] ] + ] + if + ] ] + ] + if + ] ; + +:: answer-from-cache ( MSG -- msg/f ) + [let | QUERY [ MSG message-query ] | + + [let | NX [ QUERY name>> non-existent-name? ] + RRS [ QUERY query->rrs ] | + + { + { [ NX ] [ MSG NAME-ERROR >>rcode ] } + { [ RRS ] [ MSG RRS >>answer-section ] } + { [ t ] [ f ] } + } + cond + ] + ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: message-soa ( message -- rr/soa ) + authority-section>> [ type>> SOA = ] filter first ; + +! :: cache-message ( MSG -- msg ) +! MSG rcode>> NAME-ERROR = +! [ +! [let | NAME [ MSG message-query name>> ] +! TTL [ MSG message-soa ttl>> ] | +! NAME TTL cache-non-existent-name +! ] +! ] +! when +! MSG answer-section>> [ cache-add ] each +! MSG authority-section>> [ cache-add ] each +! MSG additional-section>> [ cache-add ] each +! MSG ; + +:: cache-message ( MSG -- msg ) + MSG rcode>> NAME-ERROR = + [ + [let | RR/SOA [ MSG + authority-section>> + [ type>> SOA = ] filter + dup empty? [ drop f ] [ first ] if ] | + RR/SOA + [ + [let | NAME [ MSG message-query name>> ] + TTL [ MSG message-soa ttl>> ] | + NAME TTL cache-non-existent-name + ] + ] + when + ] + ] + when + MSG answer-section>> [ cache-add ] each + MSG authority-section>> [ cache-add ] each + MSG additional-section>> [ cache-add ] each + MSG ; + +! : answer-from-server ( msg servers -- msg ) random ask-server cache-message ; + +: answer-from-server ( msg servers -- msg ) ask-servers cache-message ; + +:: find-answer ( MSG SERVERS -- msg ) + { [ MSG answer-from-cache ] [ MSG SERVERS answer-from-server ] } 0|| ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: start-server ( ADDR-SPEC SERVERS -- ) + + [let | SOCKET [ ADDR-SPEC ] | + + [ + SOCKET receive-packet + [ parse-message SERVERS find-answer message->ba ] + change-data + respond + ] + forever + + ] ; diff --git a/dns/misc/misc.factor b/dns/misc/misc.factor new file mode 100644 index 0000000..72f553c --- /dev/null +++ b/dns/misc/misc.factor @@ -0,0 +1,34 @@ + +USING: kernel combinators sequences splitting math + io.files io.encodings.utf8 random dns.util ; + +IN: dns.misc + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: resolv-conf-servers ( -- seq ) + "/etc/resolv.conf" utf8 file-lines + [ " " split ] map + [ first "nameserver" = ] filter + [ second ] map ; + +: resolv-conf-server ( -- ip ) resolv-conf-servers random ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cdr-name ( name -- name ) dup CHAR: . index 1 + tail ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: domain-has-name? ( domain name -- ? ) + { + { [ 2dup = ] [ 2drop t ] } + { [ 2dup longer? ] [ 2drop f ] } + { [ t ] [ cdr-name domain-has-name? ] } + } + cond ; + +: name-in-domain? ( name domain -- ? ) swap domain-has-name? ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/dns/resolver/resolver.factor b/dns/resolver/resolver.factor new file mode 100644 index 0000000..32ad236 --- /dev/null +++ b/dns/resolver/resolver.factor @@ -0,0 +1,72 @@ + +USING: kernel accessors namespaces continuations + io io.sockets io.binary io.timeouts io.encodings.binary + destructors + locals strings sequences random prettyprint calendar dns dns.misc ; + +IN: dns.resolver + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: send-receive-udp ( BA SERVER -- ba ) + T{ inet4 f f 0 } + T{ duration { second 3 } } over set-timeout + [| SOCKET | BA SERVER SOCKET send SOCKET receive drop ] + with-disposal ; + +:: send-receive-tcp ( BA SERVER -- ba ) + [let | BA [ BA length 2 >be BA append ] | + SERVER binary + [ + T{ duration { second 3 } } input-stream get set-timeout + BA write flush 2 read be> read + ] + with-client ] ; + +:: send-receive-server ( BA SERVER -- msg ) + [let | RESULT [ BA SERVER send-receive-udp parse-message ] | + RESULT tc>> 1 = + [ BA SERVER send-receive-tcp parse-message ] + [ RESULT ] + if ] ; + +: >dns-inet4 ( obj -- inet4 ) dup string? [ 53 ] [ ] if ; + +:: send-receive-servers ( BA SERVERS -- msg ) + SERVERS empty? [ "send-receive-servers: servers list empty" throw ] when + [let | SERVER [ SERVERS random >dns-inet4 ] | + ! if this throws an error ... + [ BA SERVER send-receive-server ] + ! we try with the other servers... + [ drop BA SERVER SERVERS remove send-receive-servers ] + recover ] ; + +:: ask-servers ( MSG SERVERS -- msg ) + MSG message->ba SERVERS send-receive-servers ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: fully-qualified ( name -- name ) dup "." tail? [ ] [ "." append ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: dns-servers ( -- seq ) + \ dns-servers get + [ ] + [ resolv-conf-servers \ dns-servers set dns-servers ] + if* ; + +! : dns-server ( -- server ) dns-servers random ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: dns-ip4 ( name -- ips ) + fully-qualified + [let | MSG [ A IN query boa query->message dns-servers ask-servers ] | + MSG rcode>> NO-ERROR = + [ MSG answer-section>> [ type>> A = ] filter [ rdata>> ] map ] + [ "dns-ip: rcode = " MSG rcode>> unparse append throw ] + if ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/dns/server/server.factor b/dns/server/server.factor new file mode 100644 index 0000000..072e6a9 --- /dev/null +++ b/dns/server/server.factor @@ -0,0 +1,208 @@ + +USING: kernel combinators sequences sets math threads namespaces continuations + debugger io io.sockets unicode accessors destructors + combinators.short-circuit combinators.smart + fry arrays + dns dns.util dns.misc ; + +IN: dns.server + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: records-var + +: records ( -- records ) records-var get ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: {name-type-class} ( obj -- array ) + [ [ name>> >lower ] [ type>> ] [ class>> ] tri ] output>array ; + +: rr=query? ( obj obj -- ? ) [ {name-type-class} ] same? ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: matching-rrs ( query -- rrs ) records [ rr=query? ] with filter ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! zones +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: zones ( -- names ) records [ type>> NS = ] filter [ name>> ] map prune ; +: my-zones ( -- names ) records [ type>> SOA = ] filter [ name>> ] map ; + +: delegated-zones ( -- names ) zones my-zones diff ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! name->zone +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: name->zone ( name -- zone/f ) + zones sort-largest-first [ name-in-domain? ] with find nip ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! name->authority +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: name->authority ( name -- rrs-ns ) name->zone NS IN query boa matching-rrs ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! extract-names +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: rr->rdata-names ( rr -- names/f ) + { + { [ dup type>> NS = ] [ rdata>> 1array ] } + { [ dup type>> MX = ] [ rdata>> exchange>> 1array ] } + { [ dup type>> CNAME = ] [ rdata>> 1array ] } + { [ t ] [ drop f ] } + } + cond ; + +: extract-rdata-names ( message -- names ) + [ answer-section>> ] [ authority-section>> ] bi append + [ rr->rdata-names ] map concat ; + +: extract-names ( message -- names ) + [ message-query name>> ] [ extract-rdata-names ] bi swap prefix ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! fill-authority +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: fill-authority ( message -- message ) + dup + extract-names [ name->authority ] map concat prune + over answer-section>> diff + >>authority-section ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! fill-additional +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: name->rrs-a ( name -- rrs-a ) A IN query boa matching-rrs ; + +: fill-additional ( message -- message ) + dup + extract-rdata-names [ name->rrs-a ] map concat prune + over answer-section>> diff + >>additional-section ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! query->rrs +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +DEFER: query->rrs + +: matching-rrs? ( query -- rrs/f ) matching-rrs [ empty? ] [ drop f ] [ ] 1if ; + +: matching-cname? ( query -- rrs/f ) + [ ] [ clone CNAME >>type matching-rrs ] bi ! query rrs + [ empty? not ] + [ first swap clone over rdata>> >>name query->rrs swap prefix ] + [ 2drop f ] + 1if ; + +: query->rrs ( query -- rrs/f ) { [ matching-rrs? ] [ matching-cname? ] } 1|| ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! have-answers +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: have-answers ( message -- message/f ) + dup message-query query->rrs + [ empty? ] + [ 2drop f ] + [ >>answer-section fill-authority fill-additional ] + 1if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! have-delegates? +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cdr-name ( name -- name ) dup CHAR: . index 1 + tail ; + +: is-soa? ( name -- ? ) SOA IN query boa matching-rrs empty? not ; + +: have-ns? ( name -- rrs/f ) + NS IN query boa matching-rrs [ empty? ] [ drop f ] [ ] 1if ; + +: name->delegates ( name -- rrs-ns ) + { + [ "" = { } and ] + [ is-soa? { } and ] + [ have-ns? ] + [ cdr-name name->delegates ] + } + 1|| ; + +: have-delegates ( message -- message/f ) + dup message-query name>> name->delegates ! message rrs-ns + [ empty? ] + [ 2drop f ] + [ + dup [ rdata>> A IN query boa matching-rrs ] map concat + ! message rrs-ns rrs-a + [ >>authority-section ] + [ >>additional-section ] + bi* + ] + 1if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! outsize-zones +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: outside-zones ( message -- message/f ) + dup message-query name>> name->zone f = + [ ] + [ drop f ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! is-nx +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: is-nx ( message -- message/f ) + [ message-query name>> records [ name>> = ] with any? not ] + [ + NAME-ERROR >>rcode + dup + message-query name>> name->zone SOA IN query boa matching-rrs + >>authority-section + ] + [ drop f ] + 1if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: none-of-type ( message -- message ) + dup + message-query name>> name->zone SOA IN query boa matching-rrs + >>authority-section ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: find-answer ( message -- message ) + { + [ have-answers ] + [ have-delegates ] + [ outside-zones ] + [ is-nx ] + [ none-of-type ] + } + 1|| ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: (handle-request) ( packet -- ) + [ [ find-answer ] with-message-bytes ] change-data respond ; + +: handle-request ( packet -- ) [ (handle-request) ] curry in-thread ; + +: receive-loop ( socket -- ) + [ receive-packet handle-request ] [ receive-loop ] bi ; + +: loop ( addr-spec -- ) + [ '[ _ [ receive-loop ] with-disposal ] try ] [ loop ] bi ; + diff --git a/dns/stub/stub.factor b/dns/stub/stub.factor new file mode 100644 index 0000000..a15feb5 --- /dev/null +++ b/dns/stub/stub.factor @@ -0,0 +1,20 @@ + +USING: kernel sequences random accessors dns ; + +IN: dns.stub + +! Stub resolver +! +! Generally useful, but particularly when running a forwarding, +! caching, nameserver on localhost with multiple Factor instances +! querying it. + +: name->ip ( name -- ip ) + A IN query boa + query->message + ask + dup rcode>> NAME-ERROR = + [ message-query name>> name-error ] + [ answer-section>> [ type>> A = ] filter random rdata>> ] + if ; + diff --git a/dns/util/util.factor b/dns/util/util.factor new file mode 100644 index 0000000..33d6ced --- /dev/null +++ b/dns/util/util.factor @@ -0,0 +1,31 @@ + +USING: kernel sequences sorting math math.order macros fry ; + +IN: dns.util + +: tri-chain ( obj p q r -- x y z ) + [ [ call dup ] dip call dup ] dip call ; inline + +MACRO: 1if ( test then else -- ) '[ dup @ _ _ if ] ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: sort-largest-first ( seq -- seq ) [ length ] sort-with reverse ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: longer? ( seq seq -- ? ) [ length ] bi@ > ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +USING: io.sockets accessors ; + +TUPLE: packet data addr socket ; + +: receive-packet ( socket -- packet ) [ receive ] keep packet boa ; + +: respond ( packet -- ) [ data>> ] [ addr>> ] [ socket>> ] tri send ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: forever ( quot: ( -- ) -- ) [ call ] [ forever ] bi ; inline recursive diff --git a/dragdrop-listener/dragdrop-listener.factor b/dragdrop-listener/dragdrop-listener.factor new file mode 100644 index 0000000..5f3f12b --- /dev/null +++ b/dragdrop-listener/dragdrop-listener.factor @@ -0,0 +1,74 @@ +USING: alien.strings io.encodings.utf16n windows.com +windows.com.wrapper combinators windows.kernel32 windows.ole32 +windows.shell32 kernel accessors windows.types +prettyprint namespaces ui.tools.listener ui.tools.workspace +alien.data alien sequences math classes.struct ; +SPECIALIZED-ARRAY: WCHAR +IN: windows.dragdrop-listener + +: filenames-from-hdrop ( hdrop -- filenames ) + dup 0xFFFFFFFF f 0 DragQueryFile ! get count of files + [ + 2dup f 0 DragQueryFile 1 + ! get size of filename buffer + dup WCHAR + [ swap DragQueryFile drop ] keep + utf16n alien>string + ] with map ; + +: filenames-from-data-object ( data-object -- filenames ) + FORMATETC + CF_HDROP >>cfFormat + f >>ptd + DVASPECT_CONTENT >>dwAspect + -1 >>lindex + TYMED_HGLOBAL >>tymed + STGMEDIUM + [ IDataObject::GetData ] keep swap succeeded? [ + dup data>> + [ filenames-from-hdrop ] with-global-lock + swap ReleaseStgMedium + ] [ drop f ] if ; + +TUPLE: listener-dragdrop hWnd last-drop-effect ; + +: ( hWnd -- object ) + DROPEFFECT_NONE listener-dragdrop construct-boa ; + +SYMBOL: +listener-dragdrop-wrapper+ +{ + { "IDropTarget" { + [ ! DragEnter + [ + 2drop + filenames-from-data-object + length 1 = [ DROPEFFECT_COPY ] [ DROPEFFECT_NONE ] if + dup 0 + ] dip set-ulong-nth + >>last-drop-effect drop + S_OK + ] [ ! DragOver + [ 2drop last-drop-effect>> 0 ] dip set-ulong-nth + S_OK + ] [ ! DragLeave + drop S_OK + ] [ ! Drop + [ + 2drop nip + filenames-from-data-object + dup length 1 = [ + first unparse [ "USE: parser " % % " run-file" % ] "" make + eval-listener + DROPEFFECT_COPY + ] [ 2drop DROPEFFECT_NONE ] if + 0 + ] dip set-ulong-nth + S_OK + ] + } } +} +listener-dragdrop-wrapper+ set-global + +: dragdrop-listener-window ( -- ) + get-workspace parent>> handle>> hWnd>> + dup + +listener-dragdrop-wrapper+ get-global com-wrap + [ RegisterDragDrop ole32-error ] with-com-interface ; diff --git a/dragdrop-listener/platforms.txt b/dragdrop-listener/platforms.txt new file mode 100644 index 0000000..8e1a559 --- /dev/null +++ b/dragdrop-listener/platforms.txt @@ -0,0 +1 @@ +windows diff --git a/drills/deployed/deploy.factor b/drills/deployed/deploy.factor new file mode 100644 index 0000000..c1e9307 --- /dev/null +++ b/drills/deployed/deploy.factor @@ -0,0 +1,14 @@ +USING: tools.deploy.config ; +H{ + { deploy-name "drills" } + { deploy-c-types? t } + { "stop-after-last-window?" t } + { deploy-unicode? t } + { deploy-threads? t } + { deploy-reflection 6 } + { deploy-word-defs? t } + { deploy-math? t } + { deploy-ui? t } + { deploy-word-props? t } + { deploy-io 3 } +} diff --git a/drills/deployed/deployed.factor b/drills/deployed/deployed.factor new file mode 100644 index 0000000..20cdcb6 --- /dev/null +++ b/drills/deployed/deployed.factor @@ -0,0 +1,36 @@ +USING: arrays cocoa.dialogs combinators continuations +fry grouping io.encodings.utf8 io.files io.styles kernel math +math.parser models models.arrow models.history namespaces random +sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras +ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames +ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks fonts +wrap.strings system ; +EXCLUDE: accessors => change-model ; +IN: drills.deployed +SYMBOLS: it startLength ; +: big ( gadget -- gadget ) T{ font { name "sans-serif" } { size 30 } } >>font ; +: card ( model quot -- button )

big [ next ] ; +: op ( quot str -- gadget ) big swap ; + +: show ( model -- gadget ) dup it set-global [ random ] + { [ [ first ] card ] + [ [ second ] card ] + [ '[ |<< it get _ model-changed ] "No" op ] + [ '[ |<< [ it get [ + _ value>> swap remove + [ [ it get go-back ] "Drill Complete" alert return ] when-empty + ] change-model ] with-return ] "Yes" op ] + } cleave +2array { 1 0 } swap [ 0.5 track-add ] each +3array 3 3 { 1 1 } >>filled-cell { 450 175 } >>pref-dim swap { 1 1 } grid-add +it get [ length startLength get swap - number>string "/" startLength get number>string 3append ]

{ 1 2 } grid-add ; + +: drill ( -- ) [ + open-panel [ + [ utf8 file-lines [ "\t" split [ 25 wrap-string ] map ] map dup [ first2 swap 2array ] map append ] map concat + [ length startLength set-global ] keep [ add-history ] [ show ] bi + "Got it?" open-window + ] when* +] with-ui ; + +MAIN: drill diff --git a/drills/tags.txt b/drills/tags.txt new file mode 100644 index 0000000..6bf6830 --- /dev/null +++ b/drills/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/easy-help/easy-help.factor b/easy-help/easy-help.factor new file mode 100644 index 0000000..37870ab --- /dev/null +++ b/easy-help/easy-help.factor @@ -0,0 +1,111 @@ + +USING: arrays assocs compiler.units + grouping help help.markup help.topics kernel lexer multiline + namespaces parser sequences splitting words + easy-help.expand-markup ; + +IN: easy-help + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: parse-text-block ( -- array ) + + ".." parse-multiline-string + string-lines + 1 tail + [ dup " " head? [ 4 tail ] [ ] if ] map + [ expand-markup ] map + concat + [ dup "" = [ drop { $nl } ] [ ] if ] map ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: Text: parse-text-block parsed ; parsing + +: Block: scan-word 1array parse-text-block append parsed ; parsing + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: Notes: { $notes } parse-text-block append parsed ; parsing +: Description: { $description } parse-text-block append parsed ; parsing +: Contract: { $contract } parse-text-block append parsed ; parsing +: Checked-Example: { $example } parse-text-block append parsed ; parsing + +: Class-Description: + { $class-description } parse-text-block append parsed ; parsing + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: Code: + + { $code } + parse-text-block [ dup array? [ drop "" ] [ ] if ] map + append + parsed + + ; parsing + +: Example: + { $heading "Example" } + { $code } + parse-text-block + [ dup array? [ drop "" ] [ ] if ] map ! Each item in $code must be a string + append + 2array parsed ; parsing + +: Introduction: + + { $heading "Introduction" } + parse-text-block + 2array parsed ; parsing + +: Summary: + + { $heading "Summary" } + parse-text-block + 2array parsed ; parsing + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: Values: + + ".." parse-multiline-string + string-lines + 1 tail + [ dup " " head? [ 4 tail ] [ ] if ] map + [ " " split1 [ " " first = ] trim-head 2array ] map + \ $values prefix + parsed + + ; parsing + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: Word: + + scan current-vocab create dup old-definitions get + [ delete-at ] with each dup set-word + + bootstrap-word dup set-word + dup >link save-location + \ ; parse-until >array swap set-word-help ; parsing + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: Heading: { $heading } ".." parse-multiline-string suffix parsed ; parsing + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: List: + + { $list } + + ".." parse-multiline-string + string-lines + 1 tail + [ dup " " head? [ 4 tail ] [ ] if ] map + [ expand-markup ] map + + append parsed + + ; parsing diff --git a/easy-help/expand-markup/expand-markup.factor b/easy-help/expand-markup/expand-markup.factor new file mode 100644 index 0000000..7550158 --- /dev/null +++ b/easy-help/expand-markup/expand-markup.factor @@ -0,0 +1,47 @@ + +USING: accessors arrays kernel lexer locals math namespaces parser + sequences splitting ; + +IN: easy-help.expand-markup + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: scan-one-array ( string -- array rest ) + string-lines + lexer-factory get call + [ + [ + \ } parse-until >array + lexer get line-text>> + lexer get column>> tail + ] + with-lexer + ] + with-scope ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: contains-markup? ( string -- ? ) "{ $" swap subseq? ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: expand-markup ( LINE -- lines ) + + LINE contains-markup? + [ + + [let | N [ "{ $" LINE start ] | + + LINE N head + + LINE N 2 + tail scan-one-array dup " " head? [ 1 tail ] [ ] if + + [ 2array ] dip + + expand-markup + + append ] + + ] + [ LINE 1array ] + if ; diff --git a/fonts/syntax/authors.txt b/fonts/syntax/authors.txt new file mode 100644 index 0000000..2300f69 --- /dev/null +++ b/fonts/syntax/authors.txt @@ -0,0 +1 @@ +Sam Anklesaria diff --git a/fonts/syntax/summary.txt b/fonts/syntax/summary.txt new file mode 100644 index 0000000..35dcf4e --- /dev/null +++ b/fonts/syntax/summary.txt @@ -0,0 +1 @@ +Syntax for modifying gadget fonts \ No newline at end of file diff --git a/fonts/syntax/syntax-docs.factor b/fonts/syntax/syntax-docs.factor new file mode 100644 index 0000000..768f0b7 --- /dev/null +++ b/fonts/syntax/syntax-docs.factor @@ -0,0 +1,6 @@ +USING: help.syntax help.markup ; +IN: fonts.syntax + +HELP: FONT: +{ $syntax "\"testing\" FONT: 18 serif bold ... ;" } +{ $description "Used after a gadget to change font settings. Attributes can be in any order: the first number is set as the size, the style attributes like bold and italic will set the bold? and italic? slots, and font-names like serif or monospace will set the name slot." } ; diff --git a/fonts/syntax/syntax.factor b/fonts/syntax/syntax.factor new file mode 100644 index 0000000..34ccbc8 --- /dev/null +++ b/fonts/syntax/syntax.factor @@ -0,0 +1,16 @@ +USING: accessors arrays variants combinators io.styles +kernel math parser sequences fry ; +IN: fonts.syntax + +VARIANT: fontname serif monospace ; + +: install ( object quot -- quot/? ) over [ curry ] [ 2drop [ ] ] if ; + +: >>name* ( object fontname -- object ) name>> >>name ; + +SYNTAX: FONT: \ ; parse-until { + [ [ number? ] find nip [ >>size ] install ] + [ [ italic = ] find nip [ >>italic? ] install ] + [ [ bold = ] find nip [ >>bold? ] install ] + [ [ fontname? ] find nip [ >>name* ] install ] +} cleave 4array concat '[ dup font>> @ drop ] append! ; diff --git a/frame-buffer/frame-buffer.factor b/frame-buffer/frame-buffer.factor new file mode 100644 index 0000000..e8137fe --- /dev/null +++ b/frame-buffer/frame-buffer.factor @@ -0,0 +1,111 @@ + +USING: accessors alien.c-types combinators grouping kernel + locals math math.geometry.rect math.vectors opengl.gl sequences + ui.gadgets ui.render ; + +IN: frame-buffer + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < gadget pixels last-dim ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +GENERIC: update-frame-buffer ( -- ) + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: init-frame-buffer-pixels ( frame-buffer -- ) + dup + rect-dim product "uint[4]" + >>pixels + drop ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: frame-buffer ( -- ) new-gadget ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: draw-pixels ( FRAME-BUFFER -- ) + + FRAME-BUFFER rect-dim first2 + GL_RGBA + GL_UNSIGNED_INT + FRAME-BUFFER pixels>> + glDrawPixels ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: read-pixels ( FRAME-BUFFER -- ) + + 0 + 0 + FRAME-BUFFER rect-dim first2 + GL_RGBA + GL_UNSIGNED_INT + FRAME-BUFFER pixels>> + glReadPixels ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: copy-row ( OLD NEW -- ) + + [let | LEN [ OLD NEW min-length ] | + + OLD LEN head-slice 0 NEW copy ] ; + +: copy-pixels ( old-pixels old-width new-pixels new-width -- ) + [ 16 * ] 2bi@ [ copy-row ] 2each ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: update-last-dim ( frame-buffer -- ) dup rect-dim >>last-dim drop ; + +M::