Merge branch 'master' into new_ui
Slava Pestov
commit
92b9686b6c
|
|
@ -0,0 +1,44 @@
|
|||
USING: interpolate multiline
|
||||
io io.directories io.encodings.ascii io.files
|
||||
io.files.temp io.launcher io.streams.string kernel locals system
|
||||
tools.test sequences ;
|
||||
IN: alien.remote-control.tests
|
||||
|
||||
: compile-file ( contents -- )
|
||||
"test.c" ascii set-file-contents
|
||||
{ "gcc" "-I../" "-L.." "-lfactor" "test.c" }
|
||||
os macosx? cpu x86.64? and [ "-m64" suffix ] when
|
||||
try-process ;
|
||||
|
||||
: run-test ( -- line )
|
||||
os windows? "temp/a.exe" "temp/a.out" ?
|
||||
ascii [ readln ] with-process-reader ;
|
||||
|
||||
:: test-embedding ( code -- line )
|
||||
image :> image
|
||||
|
||||
[
|
||||
I[
|
||||
#include <vm/master.h>
|
||||
#include <stdio.h>
|
||||
#include <stdbool.h>
|
||||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
F_PARAMETERS p;
|
||||
default_parameters(&p);
|
||||
p.image_path = STRING_LITERAL("${image}");
|
||||
init_factor(&p);
|
||||
start_embedded_factor(&p);
|
||||
${code}
|
||||
printf("Done.\n");
|
||||
return 0;
|
||||
}
|
||||
]I
|
||||
] with-string-writer
|
||||
"resource:temp" [ compile-file ] with-directory
|
||||
"resource:" [ run-test ] with-directory ;
|
||||
|
||||
[ "Done." ] [ "" test-embedding ] unit-test
|
||||
|
||||
[ "Done." ] [ "factor_yield();" test-embedding ] unit-test
|
||||
|
|
@ -7,7 +7,13 @@ HELP: >base64
|
|||
{ $examples
|
||||
{ $example "USING: prettyprint base64 strings ;" "\"The monorail is a free service.\" >base64 >string ." "\"VGhlIG1vbm9yYWlsIGlzIGEgZnJlZSBzZXJ2aWNlLg==\"" }
|
||||
}
|
||||
{ $see-also base64> } ;
|
||||
{ $see-also base64> >base64-lines } ;
|
||||
|
||||
HELP: >base64-lines
|
||||
{ $values { "seq" sequence } { "base64" "a string of base64 characters" } }
|
||||
{ $description "Converts a sequence to its base64 representation by taking six bits at a time as an index into a lookup table containing alphanumerics, '+', and '/'. The result is padded with '=' if the input was not a multiple of six bits. A crlf is inserted for every 76 characters of output." }
|
||||
{ $see-also base64> >base64-lines } ;
|
||||
|
||||
|
||||
HELP: base64>
|
||||
{ $values { "base64" "a string of base64 characters" } { "seq" sequence } }
|
||||
|
|
@ -16,13 +22,26 @@ HELP: base64>
|
|||
{ $example "USING: prettyprint base64 strings ;" "\"VGhlIG1vbm9yYWlsIGlzIGEgZnJlZSBzZXJ2aWNlLg==\" base64> >string ." "\"The monorail is a free service.\"" }
|
||||
}
|
||||
{ $notes "This word will throw if the input string contains characters other than those allowed in base64 encodings." }
|
||||
{ $see-also >base64 } ;
|
||||
{ $see-also >base64 >base64-lines } ;
|
||||
|
||||
HELP: encode-base64
|
||||
{ $description "Reads the standard input and writes it to standard output encoded in base64." } ;
|
||||
|
||||
HELP: decode-base64
|
||||
{ $description "Reads the standard input and decodes it, writing to standard output." } ;
|
||||
|
||||
HELP: encode-base64-lines
|
||||
{ $description "Reads the standard input and writes it to standard output encoded in base64 with a crlf every 76 characters." } ;
|
||||
|
||||
ARTICLE: "base64" "Base 64 conversions"
|
||||
"The " { $vocab-link "base64" } " vocabulary implements conversions of sequences to printable characters in base 64. These plain-text representations of binary data may be passed around and converted back to binary data later." $nl
|
||||
"Converting to base 64:"
|
||||
"Converting to and from base64 as strings:"
|
||||
{ $subsection >base64 }
|
||||
"Converting back to binary:"
|
||||
{ $subsection base64> } ;
|
||||
{ $subsection >base64-lines }
|
||||
{ $subsection base64> }
|
||||
"Using base64 from streams:"
|
||||
{ $subsection encode-base64 }
|
||||
{ $subsection encode-base64-lines }
|
||||
{ $subsection decode-base64 } ;
|
||||
|
||||
ABOUT: "base64"
|
||||
|
|
|
|||
|
|
@ -74,11 +74,11 @@ PRIVATE>
|
|||
[ malformed-base64 ]
|
||||
} case ;
|
||||
|
||||
: >base64 ( str -- base64 )
|
||||
: >base64 ( seq -- base64 )
|
||||
binary [ [ encode-base64 ] with-string-reader ] with-byte-writer ;
|
||||
|
||||
: base64> ( base64 -- str )
|
||||
: base64> ( base64 -- seq )
|
||||
[ binary [ decode-base64 ] with-byte-reader ] with-string-writer ;
|
||||
|
||||
: >base64-lines ( str -- base64 )
|
||||
: >base64-lines ( seq -- base64 )
|
||||
binary [ [ encode-base64-lines ] with-string-reader ] with-byte-writer ;
|
||||
|
|
@ -3,5 +3,3 @@ USING: vocabs vocabs.loader kernel ;
|
|||
"math.ratios" require
|
||||
"math.floats" require
|
||||
"math.complex" require
|
||||
|
||||
"prettyprint" vocab [ "math.complex.prettyprint" require ] when
|
||||
|
|
|
|||
|
|
@ -3,6 +3,9 @@ namespaces sequences system combinators
|
|||
editors.vim vocabs.loader make ;
|
||||
IN: editors.gvim
|
||||
|
||||
! This code builds on the code in editors.vim; see there for
|
||||
! more information.
|
||||
|
||||
SINGLETON: gvim
|
||||
|
||||
HOOK: gvim-path io-backend ( -- path )
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ IN: editors.vim.generate-syntax
|
|||
|
||||
: generate-vim-syntax ( -- )
|
||||
"misc/factor.vim.fgen" resource-path <fhtml>
|
||||
"misc/factor.vim" resource-path
|
||||
"misc/vim/syntax/factor.vim" resource-path
|
||||
template-convert ;
|
||||
|
||||
MAIN: generate-vim-syntax
|
||||
|
|
|
|||
|
|
@ -12,5 +12,6 @@ $nl
|
|||
"USE: vim"
|
||||
"\"c:\\\\program files\\\\vim\\\\vim70\\\\gvim\" vim-path set-global"
|
||||
}
|
||||
"On Unix, you may omit the last line if " { $snippet "\"vim\"" } " is in your " { $snippet "$PATH" } "." ;
|
||||
|
||||
"On Unix, you may omit the last line if " { $snippet "\"vim\"" } " is in your " { $snippet "$PATH" } "."
|
||||
$nl
|
||||
"You may also wish to install Vim support files to enable syntax hilighting and other features. These are in the " { $link resource-path } " in " { $snippet "misc/vim" } "." ;
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ IN: io.files.windows
|
|||
CreateFile-flags f CreateFile opened-file
|
||||
] with-destructors ;
|
||||
|
||||
: open-pipe-r/w ( path -- win32-file )
|
||||
: open-r/w ( path -- win32-file )
|
||||
{ GENERIC_READ GENERIC_WRITE } flags
|
||||
OPEN_EXISTING 0 open-file ;
|
||||
|
||||
|
|
|
|||
|
|
@ -20,11 +20,11 @@ HELP: <duplex-stream>
|
|||
|
||||
HELP: with-stream
|
||||
{ $values { "stream" duplex-stream } { "quot" quotation } }
|
||||
{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } ". The stream is closed if the quotation returns or throws an error." } ;
|
||||
{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } ", which must be a duplex stream. The stream is closed if the quotation returns or throws an error." } ;
|
||||
|
||||
HELP: with-stream*
|
||||
{ $values { "stream" duplex-stream } { "quot" quotation } }
|
||||
{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } "." }
|
||||
{ $description "Calls the quotation in a new dynamic scope, with both " { $link input-stream } " and " { $link output-stream } " rebound to " { $snippet "stream" } ", which must be a duplex stream." }
|
||||
{ $notes "This word does not close the stream. Compare with " { $link with-stream } "." } ;
|
||||
|
||||
HELP: <encoder-duplex>
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel kernel.private math math.private
|
||||
math.libm math.functions arrays math.functions.private sequences
|
||||
|
|
@ -47,3 +47,9 @@ M: complex sqrt >polar [ fsqrt ] [ 2.0 / ] bi* polar> ;
|
|||
IN: syntax
|
||||
|
||||
: C{ \ } [ first2 rect> ] parse-literal ; parsing
|
||||
|
||||
USE: prettyprint.custom
|
||||
|
||||
M: complex pprint* pprint-object ;
|
||||
M: complex pprint-delims drop \ C{ \ } ;
|
||||
M: complex >pprint-sequence >rect 2array ;
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: math math.functions arrays prettyprint.custom kernel ;
|
||||
IN: math.complex.prettyprint
|
||||
|
||||
M: complex pprint* pprint-object ;
|
||||
M: complex pprint-delims drop \ C{ \ } ;
|
||||
M: complex >pprint-sequence >rect 2array ;
|
||||
|
|
@ -3,17 +3,8 @@ USING: tools.test system io.pathnames io.files io.files.info
|
|||
io.files.temp kernel tools.deploy.config
|
||||
tools.deploy.config.editor tools.deploy.backend math sequences
|
||||
io.launcher arrays namespaces continuations layouts accessors
|
||||
io.encodings.ascii urls math.parser io.directories ;
|
||||
|
||||
: shake-and-bake ( vocab -- )
|
||||
[ "test.image" temp-file delete-file ] ignore-errors
|
||||
"resource:" [
|
||||
[ vm "test.image" temp-file ] dip
|
||||
dup deploy-config make-deploy-image
|
||||
] with-directory ;
|
||||
|
||||
: small-enough? ( n -- ? )
|
||||
[ "test.image" temp-file file-info size>> ] [ cell 4 / * ] bi* <= ;
|
||||
io.encodings.ascii urls math.parser io.directories
|
||||
tools.deploy.test ;
|
||||
|
||||
[ t ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test
|
||||
|
||||
|
|
@ -36,11 +27,6 @@ os macosx? [
|
|||
[ t ] [ "webkit-demo" shake-and-bake 500000 small-enough? ] unit-test
|
||||
] when
|
||||
|
||||
: run-temp-image ( -- )
|
||||
vm
|
||||
"-i=" "test.image" temp-file append
|
||||
2array try-process ;
|
||||
|
||||
{
|
||||
"tools.deploy.test.1"
|
||||
"tools.deploy.test.2"
|
||||
|
|
@ -113,3 +99,8 @@ M: quit-responder call-responder*
|
|||
"tools.deploy.test.9" shake-and-bake
|
||||
run-temp-image
|
||||
] unit-test
|
||||
|
||||
[ ] [
|
||||
"tools.deploy.test.10" shake-and-bake
|
||||
run-temp-image
|
||||
] unit-test
|
||||
|
|
|
|||
|
|
@ -0,0 +1,4 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test tools.deploy.test.10 ;
|
||||
IN: tools.deploy.test.10.tests
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: prettyprint ;
|
||||
IN: tools.deploy.test.10
|
||||
|
||||
: main ( -- ) C{ 0 1 } pprint ;
|
||||
|
||||
MAIN: main
|
||||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
USING: tools.deploy.config ;
|
||||
H{
|
||||
{ deploy-reflection 3 }
|
||||
{ deploy-unicode? f }
|
||||
{ deploy-io 2 }
|
||||
{ deploy-word-props? f }
|
||||
{ deploy-compiler? f }
|
||||
{ deploy-threads? f }
|
||||
{ deploy-word-defs? f }
|
||||
{ "stop-after-last-window?" t }
|
||||
{ deploy-ui? f }
|
||||
{ deploy-math? t }
|
||||
{ deploy-c-types? f }
|
||||
{ deploy-name "tools.deploy.test.10" }
|
||||
}
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
USING: accessors arrays continuations io.directories io.files.info
|
||||
io.files.temp io.launcher kernel layouts math sequences system
|
||||
tools.deploy.backend tools.deploy.config.editor ;
|
||||
IN: tools.deploy.test
|
||||
|
||||
: shake-and-bake ( vocab -- )
|
||||
[ "test.image" temp-file delete-file ] ignore-errors
|
||||
"resource:" [
|
||||
[ vm "test.image" temp-file ] dip
|
||||
dup deploy-config make-deploy-image
|
||||
] with-directory ;
|
||||
|
||||
: small-enough? ( n -- ? )
|
||||
[ "test.image" temp-file file-info size>> ] [ cell 4 / * ] bi* <= ;
|
||||
|
||||
: run-temp-image ( -- )
|
||||
vm
|
||||
"-i=" "test.image" temp-file append
|
||||
2array try-process ;
|
||||
|
|
@ -28,7 +28,7 @@ IN: ui.gadgets.scrollers.tests
|
|||
"v" get [
|
||||
[ { 10 20 } ] [ "v" get model>> range-value ] unit-test
|
||||
|
||||
[ { 10 20 } ] [ "g" get rect-loc vneg { 3 3 } v+ ] unit-test
|
||||
[ { 10 20 } ] [ "g" get rect-loc vneg viewport-gap v+ scroller-border v+ ] unit-test
|
||||
] with-grafted-gadget
|
||||
|
||||
[ ] [
|
||||
|
|
@ -43,13 +43,13 @@ IN: ui.gadgets.scrollers.tests
|
|||
"s" get [
|
||||
[ { 34 34 } ] [ "s" get viewport>> rect-dim ] unit-test
|
||||
|
||||
[ { 106 106 } ] [ "s" get viewport>> viewport-dim ] unit-test
|
||||
[ { 107 107 } ] [ "s" get viewport>> viewport-dim ] unit-test
|
||||
|
||||
[ ] [ { 0 0 } "s" get scroll ] unit-test
|
||||
|
||||
[ { 0 0 } ] [ "s" get model>> range-min-value ] unit-test
|
||||
|
||||
[ { 106 106 } ] [ "s" get model>> range-max-value ] unit-test
|
||||
[ { 107 107 } ] [ "s" get model>> range-max-value ] unit-test
|
||||
|
||||
[ ] [ { 10 20 } "s" get scroll ] unit-test
|
||||
|
||||
|
|
@ -57,7 +57,7 @@ IN: ui.gadgets.scrollers.tests
|
|||
|
||||
[ { 10 20 } ] [ "s" get viewport>> model>> range-value ] unit-test
|
||||
|
||||
[ { 10 20 } ] [ "g" get rect-loc vneg { 3 3 } v+ ] unit-test
|
||||
[ { 10 20 } ] [ "g" get rect-loc vneg viewport-gap v+ scroller-border v+ ] unit-test
|
||||
] with-grafted-gadget
|
||||
|
||||
<gadget> { 600 400 } >>dim "g1" set
|
||||
|
|
@ -102,7 +102,7 @@ dup layout
|
|||
swap dup quot>> call
|
||||
dup layout
|
||||
model>> dependencies>> [ range-max value>> ] map
|
||||
viewport-gap 2 v*n =
|
||||
viewport-padding =
|
||||
] unit-test
|
||||
|
||||
\ <scroller> must-infer
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@ strings math regexp regexp.backend ;
|
|||
IN: validators
|
||||
|
||||
HELP: v-checkbox
|
||||
{ $values { "str" string } }
|
||||
{ $values { "str" string } { "?" "a boolean" } }
|
||||
{ $description "Converts the string value of a checkbox component (either \"on\" or \"off\") to a boolean value." } ;
|
||||
|
||||
HELP: v-captcha
|
||||
|
|
|
|||
|
|
@ -2,11 +2,11 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel continuations sequences math namespaces make sets
|
||||
math.parser math.ranges assocs regexp unicode.categories arrays
|
||||
hashtables words classes quotations xmode.catalog ;
|
||||
hashtables words classes quotations xmode.catalog unicode.case ;
|
||||
IN: validators
|
||||
|
||||
: v-checkbox ( str -- ? )
|
||||
"on" = ;
|
||||
>lower "on" = ;
|
||||
|
||||
: v-default ( str def -- str/def )
|
||||
over empty? spin ? ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.syntax kernel windows.types ;
|
||||
USING: alien alien.syntax kernel windows.types multiline ;
|
||||
IN: windows.kernel32
|
||||
|
||||
CONSTANT: MAX_PATH 260
|
||||
|
|
@ -197,6 +197,19 @@ CONSTANT: THREAD_PRIORITY_LOWEST -2
|
|||
CONSTANT: THREAD_PRIORITY_NORMAL 0
|
||||
CONSTANT: THREAD_PRIORITY_TIME_CRITICAL 15
|
||||
|
||||
C-ENUM:
|
||||
ComputerNameNetBIOS
|
||||
ComputerNameDnsHostname
|
||||
ComputerNameDnsDomain
|
||||
ComputerNameDnsFullyQualified
|
||||
ComputerNamePhysicalNetBIOS
|
||||
ComputerNamePhysicalDnsHostname
|
||||
ComputerNamePhysicalDnsDomain
|
||||
ComputerNamePhysicalDnsFullyQualified
|
||||
ComputerNameMax ;
|
||||
|
||||
TYPEDEF: uint COMPUTER_NAME_FORMAT
|
||||
|
||||
C-STRUCT: OVERLAPPED
|
||||
{ "UINT_PTR" "internal" }
|
||||
{ "UINT_PTR" "internal-high" }
|
||||
|
|
@ -319,6 +332,249 @@ C-STRUCT: GUID
|
|||
{ "WORD" "Data3" }
|
||||
{ { "UCHAR" 8 } "Data4" } ;
|
||||
|
||||
/*
|
||||
fBinary :1;
|
||||
fParity :1;
|
||||
fOutxCtsFlow :1;
|
||||
fOutxDsrFlow :1;
|
||||
fDtrControl :2;
|
||||
fDsrSensitivity :1;
|
||||
fTXContinueOnXoff :1;
|
||||
fOutX :1;
|
||||
fInX :1;
|
||||
fErrorChar :1;
|
||||
fNull :1;
|
||||
fRtsControl :2;
|
||||
fAbortOnError :1;
|
||||
fDummy2 :17;
|
||||
*/
|
||||
|
||||
CONSTANT: SP_SERIALCOMM HEX: 1
|
||||
CONSTANT: BAUD_075 HEX: 1
|
||||
CONSTANT: BAUD_110 HEX: 2
|
||||
CONSTANT: BAUD_134_5 HEX: 4
|
||||
CONSTANT: BAUD_150 HEX: 8
|
||||
CONSTANT: BAUD_300 HEX: 10
|
||||
CONSTANT: BAUD_600 HEX: 20
|
||||
CONSTANT: BAUD_1200 HEX: 40
|
||||
CONSTANT: BAUD_1800 HEX: 80
|
||||
CONSTANT: BAUD_2400 HEX: 100
|
||||
CONSTANT: BAUD_4800 HEX: 200
|
||||
CONSTANT: BAUD_7200 HEX: 400
|
||||
CONSTANT: BAUD_9600 HEX: 800
|
||||
CONSTANT: BAUD_14400 HEX: 1000
|
||||
CONSTANT: BAUD_19200 HEX: 2000
|
||||
CONSTANT: BAUD_38400 HEX: 4000
|
||||
CONSTANT: BAUD_56K HEX: 8000
|
||||
CONSTANT: BAUD_57600 HEX: 40000
|
||||
CONSTANT: BAUD_115200 HEX: 20000
|
||||
CONSTANT: BAUD_128K HEX: 10000
|
||||
CONSTANT: BAUD_USER HEX: 10000000
|
||||
CONSTANT: PST_FAX HEX: 21
|
||||
CONSTANT: PST_LAT HEX: 101
|
||||
CONSTANT: PST_MODEM HEX: 6
|
||||
CONSTANT: PST_NETWORK_BRIDGE HEX: 100
|
||||
CONSTANT: PST_PARALLELPORT HEX: 2
|
||||
CONSTANT: PST_RS232 HEX: 1
|
||||
CONSTANT: PST_RS422 HEX: 3
|
||||
CONSTANT: PST_RS423 HEX: 4
|
||||
CONSTANT: PST_RS449 HEX: 5
|
||||
CONSTANT: PST_SCANNER HEX: 22
|
||||
CONSTANT: PST_TCPIP_TELNET HEX: 102
|
||||
CONSTANT: PST_UNSPECIFIED 0
|
||||
CONSTANT: PST_X25 HEX: 103
|
||||
CONSTANT: PCF_16BITMODE HEX: 200
|
||||
CONSTANT: PCF_DTRDSR HEX: 1
|
||||
CONSTANT: PCF_INTTIMEOUTS HEX: 80
|
||||
CONSTANT: PCF_PARITY_CHECK HEX: 8
|
||||
CONSTANT: PCF_RLSD HEX: 4
|
||||
CONSTANT: PCF_RTSCTS HEX: 2
|
||||
CONSTANT: PCF_SETXCHAR HEX: 20
|
||||
CONSTANT: PCF_SPECIALCHARS HEX: 100
|
||||
CONSTANT: PCF_TOTALTIMEOUTS HEX: 40
|
||||
CONSTANT: PCF_XONXOFF HEX: 10
|
||||
CONSTANT: SP_BAUD HEX: 2
|
||||
CONSTANT: SP_DATABITS HEX: 4
|
||||
CONSTANT: SP_HANDSHAKING HEX: 10
|
||||
CONSTANT: SP_PARITY HEX: 1
|
||||
CONSTANT: SP_PARITY_CHECK HEX: 20
|
||||
CONSTANT: SP_RLSD HEX: 40
|
||||
CONSTANT: SP_STOPBITS HEX: 8
|
||||
CONSTANT: DATABITS_5 1
|
||||
CONSTANT: DATABITS_6 2
|
||||
CONSTANT: DATABITS_7 4
|
||||
CONSTANT: DATABITS_8 8
|
||||
CONSTANT: DATABITS_16 16
|
||||
CONSTANT: DATABITS_16X 32
|
||||
CONSTANT: STOPBITS_10 1
|
||||
CONSTANT: STOPBITS_15 2
|
||||
CONSTANT: STOPBITS_20 4
|
||||
CONSTANT: PARITY_NONE 256
|
||||
CONSTANT: PARITY_ODD 512
|
||||
CONSTANT: PARITY_EVEN 1024
|
||||
CONSTANT: PARITY_MARK 2048
|
||||
CONSTANT: PARITY_SPACE 4096
|
||||
CONSTANT: COMMPROP_INITIALIZED HEX: e73cf52e
|
||||
|
||||
CONSTANT: CBR_110 110
|
||||
CONSTANT: CBR_300 300
|
||||
CONSTANT: CBR_600 600
|
||||
CONSTANT: CBR_1200 1200
|
||||
CONSTANT: CBR_2400 2400
|
||||
CONSTANT: CBR_4800 4800
|
||||
CONSTANT: CBR_9600 9600
|
||||
CONSTANT: CBR_14400 14400
|
||||
CONSTANT: CBR_19200 19200
|
||||
CONSTANT: CBR_38400 38400
|
||||
CONSTANT: CBR_56000 56000
|
||||
CONSTANT: CBR_57600 57600
|
||||
CONSTANT: CBR_115200 115200
|
||||
CONSTANT: CBR_128000 128000
|
||||
CONSTANT: CBR_256000 256000
|
||||
CONSTANT: DTR_CONTROL_DISABLE 0
|
||||
CONSTANT: DTR_CONTROL_ENABLE 1
|
||||
CONSTANT: DTR_CONTROL_HANDSHAKE 2
|
||||
CONSTANT: RTS_CONTROL_DISABLE 0
|
||||
CONSTANT: RTS_CONTROL_ENABLE 1
|
||||
CONSTANT: RTS_CONTROL_HANDSHAKE 2
|
||||
CONSTANT: RTS_CONTROL_TOGGLE 3
|
||||
CONSTANT: EVENPARITY 2
|
||||
CONSTANT: MARKPARITY 3
|
||||
CONSTANT: NOPARITY 0
|
||||
CONSTANT: ODDPARITY 1
|
||||
CONSTANT: SPACEPARITY 4
|
||||
CONSTANT: ONESTOPBIT 0
|
||||
CONSTANT: ONE5STOPBITS 1
|
||||
CONSTANT: TWOSTOPBITS 2
|
||||
|
||||
! Flowcontrol bit mask in DCB
|
||||
CONSTANT: FM_fBinary HEX: 1
|
||||
CONSTANT: FM_fParity HEX: 2
|
||||
CONSTANT: FM_fOutxCtsFlow HEX: 4
|
||||
CONSTANT: FM_fOutxDsrFlow HEX: 8
|
||||
CONSTANT: FM_fDtrControl HEX: 30
|
||||
CONSTANT: FM_fDsrSensitivity HEX: 40
|
||||
CONSTANT: FM_fTXContinueOnXoff HEX: 80
|
||||
CONSTANT: FM_fOutX HEX: 100
|
||||
CONSTANT: FM_fInX HEX: 200
|
||||
CONSTANT: FM_fErrorChar HEX: 400
|
||||
CONSTANT: FM_fNull HEX: 800
|
||||
CONSTANT: FM_fRtsControl HEX: 3000
|
||||
CONSTANT: FM_fAbortOnError HEX: 4000
|
||||
CONSTANT: FM_fDummy2 HEX: ffff8000
|
||||
|
||||
CONSTANT: BM_fCtsHold HEX: 1
|
||||
CONSTANT: BM_fDsrHold HEX: 2
|
||||
CONSTANT: BM_fRlsdHold HEX: 4
|
||||
CONSTANT: BM_fXoffHold HEX: 8
|
||||
CONSTANT: BM_fXoffSent HEX: 10
|
||||
CONSTANT: BM_fEof HEX: 20
|
||||
CONSTANT: BM_fTxim HEX: 40
|
||||
CONSTANT: BM_AllBits HEX: 7f
|
||||
|
||||
! PurgeComm bit mask
|
||||
CONSTANT: PURGE_TXABORT HEX: 1
|
||||
CONSTANT: PURGE_RXABORT HEX: 2
|
||||
CONSTANT: PURGE_TXCLEAR HEX: 4
|
||||
CONSTANT: PURGE_RXCLEAR HEX: 8
|
||||
|
||||
! GetCommModemStatus bit mask
|
||||
CONSTANT: MS_CTS_ON HEX: 10
|
||||
CONSTANT: MS_DSR_ON HEX: 20
|
||||
CONSTANT: MS_RING_ON HEX: 40
|
||||
CONSTANT: MS_RLSD_ON HEX: 80
|
||||
|
||||
! EscapeCommFunction operations
|
||||
CONSTANT: SETXOFF HEX: 1
|
||||
CONSTANT: SETXON HEX: 2
|
||||
CONSTANT: SETRTS HEX: 3
|
||||
CONSTANT: CLRRTS HEX: 4
|
||||
CONSTANT: SETDTR HEX: 5
|
||||
CONSTANT: CLRDTR HEX: 6
|
||||
CONSTANT: SETBREAK HEX: 8
|
||||
CONSTANT: CLRBREAK HEX: 9
|
||||
|
||||
! ClearCommError bit mask
|
||||
CONSTANT: CE_RXOVER HEX: 1
|
||||
CONSTANT: CE_OVERRUN HEX: 2
|
||||
CONSTANT: CE_RXPARITY HEX: 4
|
||||
CONSTANT: CE_FRAME HEX: 8
|
||||
CONSTANT: CE_BREAK HEX: 10
|
||||
CONSTANT: CE_TXFULL HEX: 100
|
||||
! LPT only
|
||||
CONSTANT: CE_PTO HEX: 200
|
||||
CONSTANT: CE_IOE HEX: 400
|
||||
CONSTANT: CE_DNS HEX: 800
|
||||
CONSTANT: CE_OOP HEX: 1000
|
||||
! LPT only
|
||||
CONSTANT: CE_MODE HEX: 8000
|
||||
|
||||
! GetCommMask bits
|
||||
CONSTANT: EV_RXCHAR HEX: 1
|
||||
CONSTANT: EV_RXFLAG HEX: 2
|
||||
CONSTANT: EV_TXEMPTY HEX: 4
|
||||
CONSTANT: EV_CTS HEX: 8
|
||||
CONSTANT: EV_DSR HEX: 10
|
||||
CONSTANT: EV_RLSD HEX: 20
|
||||
CONSTANT: EV_BREAK HEX: 40
|
||||
CONSTANT: EV_ERR HEX: 80
|
||||
CONSTANT: EV_RING HEX: 100
|
||||
CONSTANT: EV_PERR HEX: 200
|
||||
CONSTANT: EV_RX80FULL HEX: 400
|
||||
CONSTANT: EV_EVENT1 HEX: 800
|
||||
CONSTANT: EV_EVENT2 HEX: 1000
|
||||
|
||||
C-STRUCT: DCB
|
||||
{ "DWORD" "DCBlength" }
|
||||
{ "DWORD" "BaudRate" }
|
||||
{ "DWORD" "flags" }
|
||||
{ "WORD" "wReserved" }
|
||||
{ "WORD" "XonLim" }
|
||||
{ "WORD" "XoffLim" }
|
||||
{ "BYTE" "ByteSize" }
|
||||
{ "BYTE" "Parity" }
|
||||
{ "BYTE" "StopBits" }
|
||||
{ "char" "XonChar" }
|
||||
{ "char" "XoffChar" }
|
||||
{ "char" "ErrorChar" }
|
||||
{ "char" "EofChar" }
|
||||
{ "char" "EvtChar" }
|
||||
{ "WORD" "wReserved1" } ;
|
||||
TYPEDEF: DCB* PDCB
|
||||
TYPEDEF: DCB* LPDCB
|
||||
|
||||
C-STRUCT: COMM_CONFIG
|
||||
{ "DWORD" "dwSize" }
|
||||
{ "WORD" "wVersion" }
|
||||
{ "WORD" "wReserved" }
|
||||
{ "DCB" "dcb" }
|
||||
{ "DWORD" "dwProviderSubType" }
|
||||
{ "DWORD" "dwProviderOffset" }
|
||||
{ "DWORD" "dwProviderSize" }
|
||||
{ { "WCHAR" 1 } "wcProviderData" } ;
|
||||
TYPEDEF: COMMCONFIG* LPCOMMCONFIG
|
||||
|
||||
C-STRUCT: COMMPROP
|
||||
{ "WORD" "wPacketLength" }
|
||||
{ "WORD" "wPacketVersion" }
|
||||
{ "DWORD" "dwServiceMask" }
|
||||
{ "DWORD" "dwReserved1" }
|
||||
{ "DWORD" "dwMaxTxQueue" }
|
||||
{ "DWORD" "dwMaxRxQueue" }
|
||||
{ "DWORD" "dwMaxBaud" }
|
||||
{ "DWORD" "dwProvSubType" }
|
||||
{ "DWORD" "dwProvCapabilities" }
|
||||
{ "DWORD" "dwSettableParams" }
|
||||
{ "DWORD" "dwSettableBaud" }
|
||||
{ "WORD" "wSettableData" }
|
||||
{ "WORD" "wSettableStopParity" }
|
||||
{ "DWORD" "dwCurrentTxQueue" }
|
||||
{ "DWORD" "dwCurrentRxQueue" }
|
||||
{ "DWORD" "dwProvSpec1" }
|
||||
{ "DWORD" "dwProvSpec2" }
|
||||
{ { "WCHAR" 1 } "wcProvChar" } ;
|
||||
TYPEDEF: COMMPROP* LPCOMMPROP
|
||||
|
||||
|
||||
CONSTANT: SE_CREATE_TOKEN_NAME "SeCreateTokenPrivilege"
|
||||
CONSTANT: SE_ASSIGNPRIMARYTOKEN_NAME "SeAssignPrimaryTokenPrivilege"
|
||||
|
|
@ -875,19 +1131,19 @@ ALIAS: FreeEnvironmentStrings FreeEnvironmentStringsW
|
|||
! FUNCTION: GetCalendarInfoW
|
||||
! FUNCTION: GetCommandLineA
|
||||
! FUNCTION: GetCommandLineW
|
||||
! FUNCTION: GetCommConfig
|
||||
! FUNCTION: GetCommMask
|
||||
! FUNCTION: GetCommModemStatus
|
||||
! FUNCTION: GetCommProperties
|
||||
! FUNCTION: GetCommState
|
||||
FUNCTION: BOOL GetCommConfig ( HANDLE hCommDev, LPCOMMCONFIG lpCC, LPDWORD lpdwSize ) ;
|
||||
FUNCTION: BOOL GetCommMask ( HANDLE hFile, LPDWORD lpEvtMask ) ;
|
||||
FUNCTION: BOOL GetCommModemStatus ( HANDLE hFile, LPDWORD lpModemStat ) ;
|
||||
FUNCTION: BOOL GetCommProperties ( HANDLE hFile, LPCOMMPROP lpCommProp ) ;
|
||||
FUNCTION: BOOL GetCommState ( HANDLE hFile, LPDCB lpDCB ) ;
|
||||
! FUNCTION: GetCommTimeouts
|
||||
! FUNCTION: GetComPlusPackageInstallStatus
|
||||
! FUNCTION: GetCompressedFileSizeA
|
||||
! FUNCTION: GetCompressedFileSizeW
|
||||
FUNCTION: BOOL GetComputerNameW ( LPTSTR lpBuffer, LPDWORD lpnSize ) ;
|
||||
! FUNCTION: GetComputerNameExW
|
||||
! FUNCTION: GetComputerNameW
|
||||
ALIAS: GetComputerName GetComputerNameW
|
||||
FUNCTION: BOOL GetComputerNameExW ( COMPUTER_NAME_FORMAT NameType, LPTSTR lpBuffer, LPDWORD lpnSize ) ;
|
||||
ALIAS: GetComputerNameEx GetComputerNameExW
|
||||
! FUNCTION: GetConsoleAliasA
|
||||
! FUNCTION: GetConsoleAliasesA
|
||||
! FUNCTION: GetConsoleAliasesLengthA
|
||||
|
|
@ -942,7 +1198,8 @@ FUNCTION: HANDLE GetCurrentThread ( ) ;
|
|||
! FUNCTION: GetDateFormatA
|
||||
! FUNCTION: GetDateFormatW
|
||||
! FUNCTION: GetDefaultCommConfigA
|
||||
! FUNCTION: GetDefaultCommConfigW
|
||||
FUNCTION: BOOL GetDefaultCommConfigW ( LPCTSTR lpszName, LPCOMMCONFIG lpCC, LPDWORD lpdwSize ) ;
|
||||
ALIAS: GetDefaultCommConfig GetDefaultCommConfigW
|
||||
! FUNCTION: GetDefaultSortkeySize
|
||||
! FUNCTION: GetDevicePowerState
|
||||
! FUNCTION: GetDiskFreeSpaceA
|
||||
|
|
@ -1400,10 +1657,10 @@ ALIAS: RemoveDirectory RemoveDirectoryW
|
|||
! FUNCTION: SetCalendarInfoA
|
||||
! FUNCTION: SetCalendarInfoW
|
||||
! FUNCTION: SetClientTimeZoneInformation
|
||||
! FUNCTION: SetCommBreak
|
||||
! FUNCTION: SetCommConfig
|
||||
! FUNCTION: SetCommMask
|
||||
! FUNCTION: SetCommState
|
||||
FUNCTION: BOOL SetCommBreak ( HANDLE hFile ) ;
|
||||
FUNCTION: BOOL SetCommConfig ( HANDLE hCommDev, LPCOMMCONFIG lpCC, DWORD dwSize ) ;
|
||||
FUNCTION: BOOL SetCommMask ( HANDLE hFile, DWORD dwEvtMask ) ;
|
||||
FUNCTION: BOOL SetCommState ( HANDLE hFile, LPDCB lpDCB ) ;
|
||||
! FUNCTION: SetCommTimeouts
|
||||
! FUNCTION: SetComPlusPackageInstallStatus
|
||||
! FUNCTION: SetComputerNameA
|
||||
|
|
@ -1446,7 +1703,8 @@ ALIAS: SetConsoleTitle SetConsoleTitleW
|
|||
FUNCTION: BOOL SetCurrentDirectoryW ( LPCWSTR lpDirectory ) ;
|
||||
ALIAS: SetCurrentDirectory SetCurrentDirectoryW
|
||||
! FUNCTION: SetDefaultCommConfigA
|
||||
! FUNCTION: SetDefaultCommConfigW
|
||||
FUNCTION: BOOL SetDefaultCommConfigW ( LPCTSTR lpszName, LPCOMMCONFIG lpCC, LPDWORD lpdwSize ) ;
|
||||
ALIAS: SetDefaultCommConfig SetDefaultCommConfigW
|
||||
! FUNCTION: SetDllDirectoryA
|
||||
! FUNCTION: SetDllDirectoryW
|
||||
FUNCTION: BOOL SetEndOfFile ( HANDLE hFile ) ;
|
||||
|
|
|
|||
|
|
@ -1,13 +1,13 @@
|
|||
|
||||
USING: accessors combinators.cleave combinators.short-circuit
|
||||
concurrency.combinators destructors fry io io.directories
|
||||
io.encodings io.encodings.utf8 io.launcher io.pathnames
|
||||
io.pipes io.ports kernel locals math namespaces sequences
|
||||
splitting strings ui ui.gadgets ui.gadgets.buttons
|
||||
ui.gadgets.editors ui.gadgets.labels ui.gadgets.packs
|
||||
ui.gadgets.tracks ;
|
||||
io.encodings io.encodings.utf8 io.launcher io.monitors
|
||||
io.pathnames io.pipes io.ports kernel locals math namespaces
|
||||
sequences splitting strings threads ui ui.gadgets
|
||||
ui.gadgets.buttons ui.gadgets.editors ui.gadgets.labels
|
||||
ui.gadgets.packs ui.gadgets.tracks ;
|
||||
|
||||
IN: git-status
|
||||
IN: git-tool
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -116,11 +116,11 @@ TUPLE: <git-status>
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: refresh-git-status ( GIT-STATUS -- GIT-STATUS )
|
||||
:: refresh-git-status ( STATUS -- STATUS )
|
||||
|
||||
[let | LINES [ GIT-STATUS repository>> "git-status" git-process stdout>> ] |
|
||||
[let | LINES [ STATUS repository>> { "git" "status" } git-process stdout>> ] |
|
||||
|
||||
GIT-STATUS
|
||||
STATUS
|
||||
|
||||
LINES "# Changes to be committed:" git-status-section
|
||||
[ "new file:" head? ] filter
|
||||
|
|
@ -269,7 +269,7 @@ TUPLE: <git-status>
|
|||
"Diff"
|
||||
[
|
||||
drop
|
||||
STATUS repository>> { "git-diff" PATH } git-process
|
||||
STATUS repository>> { "git" "diff" PATH } git-process
|
||||
popup-process-window
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
|
@ -320,7 +320,7 @@ TUPLE: <git-status>
|
|||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: git-remote-branches ( REPO NAME -- seq )
|
||||
REPO { "git-remote" "show" NAME } git-process stdout>>
|
||||
REPO { "git" "remote" "show" NAME } git-process stdout>>
|
||||
" Tracked remote branches" over index 1 + tail first " " split
|
||||
[ empty? not ] filter ;
|
||||
|
||||
|
|
@ -334,7 +334,7 @@ TUPLE: <git-status>
|
|||
|
||||
"Remotes" <label> reverse-video-theme add-gadget
|
||||
|
||||
REPO "git-remote" git-process stdout>> [ empty? not ] filter
|
||||
REPO { "git" "remote" } git-process stdout>> [ empty? not ] filter
|
||||
|
||||
[| NAME |
|
||||
|
||||
|
|
@ -377,7 +377,7 @@ TUPLE: <git-status>
|
|||
1 track-add ]
|
||||
|
||||
"Fetch"
|
||||
[ drop REPO { "git-fetch" NAME } git-process popup-process-window ]
|
||||
[ drop REPO { "git" "fetch" NAME } git-process popup-process-window ]
|
||||
<bevel-button>
|
||||
1 track-add
|
||||
|
||||
|
|
@ -385,7 +385,7 @@ TUPLE: <git-status>
|
|||
[
|
||||
drop
|
||||
[let | ARG [ { ".." NAME "/" BRANCH } concat ] |
|
||||
REPO { "git-log" ARG } git-process popup-process-window ]
|
||||
REPO { "git" "log" ARG } git-process popup-process-window ]
|
||||
]
|
||||
<bevel-button>
|
||||
1 track-add
|
||||
|
|
@ -394,7 +394,7 @@ TUPLE: <git-status>
|
|||
[
|
||||
drop
|
||||
[let | ARG [ { NAME "/" BRANCH } concat ] |
|
||||
REPO { "git-merge" ARG } git-process popup-process-window ]
|
||||
REPO { "git" "merge" ARG } git-process popup-process-window ]
|
||||
]
|
||||
<bevel-button>
|
||||
1 track-add
|
||||
|
|
@ -403,7 +403,7 @@ TUPLE: <git-status>
|
|||
[
|
||||
drop
|
||||
[let | ARG [ { NAME "/" BRANCH ".." } concat ] |
|
||||
REPO { "git-log" ARG } git-process popup-process-window ]
|
||||
REPO { "git" "log" ARG } git-process popup-process-window ]
|
||||
]
|
||||
<bevel-button>
|
||||
1 track-add
|
||||
|
|
@ -411,7 +411,7 @@ TUPLE: <git-status>
|
|||
"Push"
|
||||
[
|
||||
drop
|
||||
REPO { "git-push" NAME "master" } git-process popup-process-window
|
||||
REPO { "git" "push" NAME "master" } git-process popup-process-window
|
||||
]
|
||||
<bevel-button>
|
||||
1 track-add
|
||||
|
|
@ -433,8 +433,32 @@ TUPLE: <git-status>
|
|||
<label>
|
||||
add-gadget
|
||||
|
||||
REPO git-status <pile> 1 >>fill tuck refresh-status-pile add-gadget
|
||||
REPO <pile> 1 >>fill tuck refresh-remotes-pile add-gadget
|
||||
[let | STATUS [ REPO git-status ]
|
||||
PILE [ <pile> 1 >>fill ] |
|
||||
|
||||
[
|
||||
[
|
||||
[let | MONITOR [ REPO t <monitor> ] |
|
||||
[
|
||||
[let | PATH [ MONITOR next-change drop ] |
|
||||
".git" PATH subseq? ! Ignore git internal operations
|
||||
[ ]
|
||||
[ STATUS PILE refresh-status-pile ]
|
||||
if
|
||||
t ]
|
||||
]
|
||||
loop
|
||||
]
|
||||
]
|
||||
with-monitors
|
||||
]
|
||||
in-thread
|
||||
|
||||
STATUS PILE refresh-status-pile
|
||||
|
||||
PILE add-gadget ]
|
||||
|
||||
REPO <pile> 1 >>fill tuck refresh-remotes-pile add-gadget
|
||||
|
||||
"Git" open-window ;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,392 @@
|
|||
|
||||
USING: accessors calendar git-tool git-tool io.directories
|
||||
io.monitors io.pathnames kernel locals math namespaces
|
||||
sequences splitting system threads ui ui.gadgets
|
||||
ui.gadgets.buttons ui.gadgets.labels ui.gadgets.packs ;
|
||||
|
||||
USING: git-tool ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
IN: git-tool.remote
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: <git-remote-gadget> < pack
|
||||
repository
|
||||
branch
|
||||
remote
|
||||
remote-branch
|
||||
fetch-period
|
||||
push
|
||||
closed
|
||||
last-refresh ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: current-branch ( REPO -- branch )
|
||||
{ "git" "branch" } git-process stdout>> [ "* " head? ] find nip 2 tail ;
|
||||
|
||||
: list-branches ( REPO -- branches )
|
||||
{ "git" "branch" } git-process stdout>>
|
||||
[ empty? not ] filter
|
||||
[ 2 tail ] map ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: list-remotes ( REPO -- remotes )
|
||||
{ "git" "remote" } git-process stdout>> [ empty? not ] filter ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: list-remote-branches ( REPO REMOTE -- branches )
|
||||
[let | OUT [ REPO { "git" "remote" "show" REMOTE } git-process stdout>> ] |
|
||||
|
||||
" Tracked remote branches" OUT member?
|
||||
[
|
||||
OUT
|
||||
" Tracked remote branches" OUT index 1 + tail first " " split
|
||||
[ empty? not ] filter
|
||||
]
|
||||
[
|
||||
OUT
|
||||
OUT [ " New remote branches" head? ] find drop
|
||||
1 + tail first " " split
|
||||
[ empty? not ] filter
|
||||
]
|
||||
if ] ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: refresh-git-remote-gadget ( GADGET -- )
|
||||
|
||||
[let | REPO [ GADGET repository>> ] |
|
||||
|
||||
GADGET clear-gadget
|
||||
|
||||
GADGET
|
||||
|
||||
! Repository label
|
||||
|
||||
"Repository: " REPO [ current-directory get ] with-directory append
|
||||
<label>
|
||||
add-gadget
|
||||
|
||||
! Branch button
|
||||
|
||||
<shelf>
|
||||
|
||||
"Branch: " <label> add-gadget
|
||||
|
||||
REPO current-branch
|
||||
[
|
||||
drop
|
||||
|
||||
<pile>
|
||||
REPO list-branches
|
||||
|
||||
[| BRANCH |
|
||||
|
||||
BRANCH
|
||||
[
|
||||
drop
|
||||
REPO { "git" "checkout" BRANCH } git-process popup-if-error
|
||||
GADGET refresh-git-remote-gadget
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
||||
]
|
||||
each
|
||||
|
||||
"Select a branch" open-window
|
||||
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
||||
add-gadget
|
||||
|
||||
! Remote button
|
||||
|
||||
<shelf>
|
||||
|
||||
"Remote: " <label> add-gadget
|
||||
|
||||
GADGET remote>>
|
||||
[
|
||||
drop
|
||||
|
||||
<pile>
|
||||
|
||||
REPO list-remotes
|
||||
|
||||
[| REMOTE |
|
||||
|
||||
REMOTE
|
||||
[
|
||||
drop
|
||||
GADGET REMOTE >>remote drop
|
||||
GADGET "master" >>remote-branch drop
|
||||
GADGET refresh-git-remote-gadget
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
||||
]
|
||||
each
|
||||
|
||||
"Select a remote" open-window
|
||||
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
||||
add-gadget
|
||||
|
||||
! Remote branch button
|
||||
|
||||
<shelf>
|
||||
|
||||
"Remote branch: " <label> add-gadget
|
||||
|
||||
GADGET remote-branch>>
|
||||
[
|
||||
drop
|
||||
|
||||
<pile>
|
||||
|
||||
REPO GADGET remote>> list-remote-branches
|
||||
|
||||
[| REMOTE-BRANCH |
|
||||
|
||||
REMOTE-BRANCH
|
||||
[
|
||||
drop
|
||||
GADGET REMOTE-BRANCH >>remote-branch drop
|
||||
GADGET refresh-git-remote-gadget
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
]
|
||||
|
||||
each
|
||||
|
||||
"Select a remote branch" open-window
|
||||
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
||||
add-gadget
|
||||
|
||||
! Fetch button
|
||||
|
||||
"Fetch"
|
||||
[
|
||||
drop
|
||||
[let | REMOTE [ GADGET remote>> ] |
|
||||
REPO { "git" "fetch" REMOTE } git-process popup-if-error ]
|
||||
|
||||
GADGET refresh-git-remote-gadget
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
||||
! Available changes
|
||||
|
||||
[let | REMOTE [ GADGET remote>> ]
|
||||
REMOTE-BRANCH [ GADGET remote-branch>> ] |
|
||||
|
||||
[let | ARG [ { ".." REMOTE "/" REMOTE-BRANCH } concat ] |
|
||||
|
||||
[let | PROCESS [ REPO { "git" "log" ARG } git-process ] |
|
||||
|
||||
PROCESS stdout>>
|
||||
[
|
||||
<shelf>
|
||||
|
||||
"Changes available:" <label> add-gadget
|
||||
|
||||
"View"
|
||||
[
|
||||
drop
|
||||
PROCESS popup-process-window
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
||||
"Merge"
|
||||
[
|
||||
drop
|
||||
|
||||
[let | ARG [ { REMOTE "/" REMOTE-BRANCH } concat ] |
|
||||
|
||||
REPO { "git" "merge" ARG } git-process popup-process-window
|
||||
|
||||
]
|
||||
|
||||
GADGET refresh-git-remote-gadget
|
||||
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
||||
add-gadget
|
||||
|
||||
]
|
||||
when
|
||||
|
||||
] ] ]
|
||||
|
||||
|
||||
! Pushable changes
|
||||
|
||||
[let | REMOTE [ GADGET remote>> ]
|
||||
REMOTE-BRANCH [ GADGET remote-branch>> ] |
|
||||
|
||||
[let | ARG [ { REMOTE "/" REMOTE-BRANCH ".." } concat ] |
|
||||
|
||||
[let | PROCESS [ REPO { "git" "log" ARG } git-process ] |
|
||||
|
||||
PROCESS stdout>>
|
||||
[
|
||||
<shelf>
|
||||
|
||||
"Pushable changes: " <label> add-gadget
|
||||
|
||||
"View"
|
||||
[
|
||||
drop
|
||||
PROCESS popup-process-window
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
||||
"Push"
|
||||
[
|
||||
drop
|
||||
|
||||
REPO { "git" "push" REMOTE REMOTE-BRANCH }
|
||||
git-process
|
||||
popup-process-window
|
||||
|
||||
GADGET refresh-git-remote-gadget
|
||||
|
||||
]
|
||||
<bevel-button> add-gadget
|
||||
|
||||
add-gadget
|
||||
|
||||
]
|
||||
when
|
||||
|
||||
] ] ]
|
||||
|
||||
drop
|
||||
|
||||
] ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: start-fetch-thread ( GADGET -- )
|
||||
|
||||
GADGET f >>closed drop
|
||||
|
||||
[
|
||||
|
||||
[
|
||||
|
||||
GADGET closed>>
|
||||
[ f ]
|
||||
[
|
||||
[let | REPO [ GADGET repository>> ]
|
||||
REMOTE-BRANCH [ GADGET remote-branch>> ] |
|
||||
|
||||
REPO { "git" "fetch" REMOTE-BRANCH } git-process drop ]
|
||||
|
||||
GADGET fetch-period>> sleep
|
||||
|
||||
t
|
||||
]
|
||||
if
|
||||
|
||||
|
||||
]
|
||||
loop
|
||||
|
||||
]
|
||||
|
||||
in-thread ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: start-monitor-thread ( GADGET -- )
|
||||
|
||||
GADGET f >>closed drop
|
||||
|
||||
[
|
||||
[
|
||||
[let | MONITOR [ GADGET repository>> t <monitor> ] |
|
||||
|
||||
[
|
||||
GADGET closed>>
|
||||
[ f ]
|
||||
[
|
||||
|
||||
[let | PATH [ MONITOR next-change drop ] |
|
||||
|
||||
".git" PATH subseq?
|
||||
[ ]
|
||||
[
|
||||
micros
|
||||
GADGET last-refresh>> 0 or -
|
||||
1000000 >
|
||||
[
|
||||
GADGET micros >>last-refresh drop
|
||||
GADGET refresh-git-remote-gadget
|
||||
]
|
||||
when
|
||||
]
|
||||
if ]
|
||||
|
||||
t
|
||||
|
||||
]
|
||||
if
|
||||
]
|
||||
loop
|
||||
]
|
||||
]
|
||||
with-monitors
|
||||
]
|
||||
in-thread ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
M: <git-remote-gadget> pref-dim* ( gadget -- dim ) drop { 500 500 } ;
|
||||
|
||||
M:: <git-remote-gadget> graft* ( GADGET -- )
|
||||
GADGET start-fetch-thread
|
||||
GADGET start-monitor-thread ;
|
||||
|
||||
M:: <git-remote-gadget> ungraft* ( GADGET -- ) GADGET t >>closed drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
:: git-remote-tool ( REPO -- )
|
||||
|
||||
<git-remote-gadget> new-gadget
|
||||
|
||||
{ 0 1 } >>orientation
|
||||
1 >>fill
|
||||
|
||||
REPO >>repository
|
||||
|
||||
"origin" >>remote
|
||||
|
||||
"master" >>remote-branch
|
||||
|
||||
5 minutes >>fetch-period
|
||||
|
||||
dup refresh-git-remote-gadget
|
||||
|
||||
"git-remote-tool" open-window ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: factor-git-remote-tool ( -- ) "resource:" git-remote-tool ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
MAIN: factor-git-remote-tool
|
||||
|
|
@ -20,4 +20,5 @@ M: serial dispose ( serial -- ) stream>> dispose ;
|
|||
|
||||
{
|
||||
{ [ os unix? ] [ "serial.unix" ] }
|
||||
{ [ os windows? ] [ "serial.windows" ] }
|
||||
} cond require
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
unportable
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
! Copyright (C) 2009 Your name.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test serial.windows ;
|
||||
IN: serial.windows.tests
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.files.windows io.streams.duplex kernel math
|
||||
math.bitwise windows.kernel32 accessors alien.c-types
|
||||
windows io.files.windows fry locals continuations ;
|
||||
IN: serial.windows
|
||||
|
||||
: <serial-stream> ( path encoding -- duplex )
|
||||
[ open-r/w dup ] dip <encoder-duplex> ;
|
||||
|
||||
: get-comm-state ( duplex -- dcb )
|
||||
in>> handle>>
|
||||
"DCB" <c-object> tuck
|
||||
GetCommState win32-error=0/f ;
|
||||
|
||||
: set-comm-state ( duplex dcb -- )
|
||||
[ in>> handle>> ] dip
|
||||
SetCommState win32-error=0/f ;
|
||||
|
||||
:: with-comm-state ( duplex quot: ( dcb -- ) -- )
|
||||
duplex get-comm-state :> dcb
|
||||
dcb clone quot curry [ dcb set-comm-state ] recover ; inline
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
Vim support for Factor
|
||||
----------------------
|
||||
|
||||
This directory contains various support files that make editing Factor code
|
||||
more pleasant in Vim. The file-layout exactly matches the Vim runtime
|
||||
structure, so you can install them by copying the contents of this directory
|
||||
into ~/.vim/ or the equivalent path on other platforms (Open Vim and type
|
||||
":help 'runtimepath'" for details).
|
||||
|
||||
The current set of files is as follows:
|
||||
|
||||
ftdetect/factor.vim
|
||||
Teach Vim when to load Factor support files.
|
||||
ftplugin/factor_settings.vim
|
||||
Teach Vim to follow the Factor Coding Style guidelines.
|
||||
syntax/factor.vim
|
||||
Syntax highlighting for Factor code.
|
||||
|
||||
Note: The syntax-highlighting file is automatically generated to include the
|
||||
names of all the vocabularies Factor knows about. To regenerate it manually,
|
||||
run the following code in the listener:
|
||||
|
||||
USE: editors.vim.generate-syntax
|
||||
|
||||
generate-vim-syntax
|
||||
|
||||
...or run it from the command-line:
|
||||
|
||||
factor -run=editors.vim.generate-syntax
|
||||
|
|
@ -0,0 +1 @@
|
|||
autocmd BufRead,BufNewFile *.factor,{,.}factor*-rc set filetype=factor
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
" Code formatting settings loosely adapted from:
|
||||
" http://concatenative.org/wiki/view/Factor/Coding%20Style
|
||||
|
||||
" Tabs are not allowed in Factor source files; use four spaces instead.
|
||||
setlocal expandtab tabstop=4 shiftwidth=4 softtabstop=4
|
||||
|
||||
" Try to limit lines to 64 characters, except for documentation, which can be
|
||||
" any length.
|
||||
if expand("%:t") !~ "-docs\.factor$"
|
||||
setlocal textwidth=64
|
||||
|
||||
" Mark anything in column 64 or beyond as a syntax error.
|
||||
match Error /\%>63v.\+/
|
||||
endif
|
||||
|
||||
" Teach Vim what comments look like.
|
||||
setlocal comments+=b:!,b:#!
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
|
||||
USING: kernel sequences quotations assocs math math.parser
|
||||
combinators.lib vars lsys.strings combinators.short-circuit ;
|
||||
|
||||
IN: lsys.strings.interpret
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: command-table
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: exec-command ( string -- ) command-table> at >quotation call ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: command ( string -- command ) 1 head ;
|
||||
|
||||
: parameter ( string -- parameter )
|
||||
[ drop 2 ] [ length 1- ] [ ] tri subseq string>number ;
|
||||
|
||||
: exec-command* ( string -- )
|
||||
[ parameter ] [ command ] bi
|
||||
command-table> at dup
|
||||
[ 1 tail* call ] [ 2drop ] if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: (interpret) ( slice -- )
|
||||
{ { [ empty? ] [ drop ] }
|
||||
{ [ has-param? ] [ next+rest* [ exec-command* ] [ (interpret) ] bi* ] }
|
||||
{ [ t ] [ next+rest [ exec-command ] [ (interpret) ] bi* ] } }
|
||||
switch ;
|
||||
|
||||
: interpret ( string -- ) <flat-slice> (interpret) ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1,36 +0,0 @@
|
|||
|
||||
USING: kernel sbufs strings sequences assocs math
|
||||
combinators.lib vars lsys.strings combinators.short-circuit ;
|
||||
|
||||
IN: lsys.strings.rewrite
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: rules
|
||||
|
||||
: lookup ( str -- str ) [ 1 head rules> at ] [ ] bi or ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: accum
|
||||
|
||||
: push-next ( next -- ) lookup accum> push-all ;
|
||||
|
||||
: (rewrite) ( slice -- )
|
||||
{ { [ empty? ] [ drop ] }
|
||||
{ [ has-param? ] [ next+rest* [ push-next ] [ (rewrite) ] bi* ] }
|
||||
{ [ t ] [ next+rest [ push-next ] [ (rewrite) ] bi* ] } }
|
||||
switch ;
|
||||
|
||||
: rewrite ( string -- string )
|
||||
dup length 10 * <sbuf> >accum
|
||||
<flat-slice> (rewrite)
|
||||
accum> >string ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: result
|
||||
|
||||
: iterate ( -- ) result> rewrite >result ;
|
||||
|
||||
: iterations ( n -- ) [ iterate ] times ;
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
|
||||
USING: kernel sequences math combinators.lib combinators.short-circuit ;
|
||||
|
||||
IN: lsys.strings
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: has-param? ( slice -- ? ) { [ length 1 > ] [ second CHAR: ( = ] } 1&& ;
|
||||
|
||||
: next+rest ( slice -- next rest ) [ 1 head ] [ 1 tail-slice ] bi ;
|
||||
|
||||
: index-rest ( slice -- i ) CHAR: ) swap index 1+ ;
|
||||
|
||||
: next+rest* ( slice -- next rest ) dup index-rest [ head ] [ tail-slice ] 2bi ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Lindenmayer system explorer
|
||||
|
|
@ -1 +0,0 @@
|
|||
applications
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1,153 +0,0 @@
|
|||
|
||||
USING: kernel math vectors sequences opengl.gl math.vectors math.order
|
||||
math.matrices vars opengl self pos ori turtle lsys.tortoise
|
||||
|
||||
lsys.strings.interpret combinators.short-circuit ;
|
||||
|
||||
! lsys.strings
|
||||
|
||||
IN: lsys.tortoise.graphics
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! (v0 - v1) x (v1 - v2)
|
||||
|
||||
: polygon-normal ( {_v0_v1_v2_} -- normal ) first3 dupd v- -rot v- swap cross ;
|
||||
|
||||
: (polygon) ( vertices -- )
|
||||
GL_POLYGON glBegin
|
||||
dup polygon-normal gl-normal [ gl-vertex ] each
|
||||
glEnd ;
|
||||
|
||||
: polygon ( vertices -- ) dup length 3 >= [ (polygon) ] [ drop ] if ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: vertices
|
||||
|
||||
! : init-vertices ( -- ) 0 <vector> >vertices ;
|
||||
|
||||
: start-polygon ( -- ) vertices> delete-all ;
|
||||
|
||||
: finish-polygon ( -- ) vertices> polygon ;
|
||||
|
||||
: polygon-vertex ( -- ) pos> vertices> push ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: record-vertex ( -- ) pos> gl-vertex ;
|
||||
|
||||
: draw-forward ( length -- )
|
||||
GL_LINES glBegin record-vertex step-turtle record-vertex glEnd ;
|
||||
|
||||
: move-forward ( length -- ) step-turtle polygon-vertex ;
|
||||
|
||||
: sneak-forward ( length -- ) step-turtle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: scale-len ( m -- ) len> * >len ;
|
||||
|
||||
: scale-angle ( m -- ) angle> * >angle ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: set-thickness ( i -- ) dup >thickness glLineWidth ;
|
||||
|
||||
: scale-thickness ( m -- ) thickness> * 0.5 max set-thickness ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: color-table
|
||||
|
||||
: init-color-table ( -- )
|
||||
{ { 0 0 0 } ! black
|
||||
{ 0.5 0.5 0.5 } ! grey
|
||||
{ 1 0 0 } ! red
|
||||
{ 1 1 0 } ! yellow
|
||||
{ 0 1 0 } ! green
|
||||
{ 0.25 0.88 0.82 } ! turquoise
|
||||
{ 0 0 1 } ! blue
|
||||
{ 0.63 0.13 0.94 } ! purple
|
||||
{ 0.00 0.50 0.00 } ! dark green
|
||||
{ 0.00 0.82 0.82 } ! dark turquoise
|
||||
{ 0.00 0.00 0.50 } ! dark blue
|
||||
{ 0.58 0.00 0.82 } ! dark purple
|
||||
{ 0.50 0.00 0.00 } ! dark red
|
||||
{ 0.25 0.25 0.25 } ! dark grey
|
||||
{ 0.75 0.75 0.75 } ! medium grey
|
||||
{ 1 1 1 } ! white
|
||||
} [ 1 suffix ] map >color-table ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: material-color ( color -- )
|
||||
GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE rot gl-material ;
|
||||
|
||||
: set-color ( i -- )
|
||||
dup >color color-table> nth dup gl-color material-color ;
|
||||
|
||||
: inc-color ( -- ) color> 1+ set-color ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: tortoise-stack
|
||||
|
||||
! : init-tortoise-stack ( -- ) V{ } clone >tortoise-stack ;
|
||||
|
||||
! : save-tortoise ( -- ) self> tortoise-stack> push ;
|
||||
|
||||
! : save-tortoise ( -- ) self> tortoise-stack> push self> clone >self ;
|
||||
|
||||
: save-tortoise ( -- ) self> clone tortoise-stack> push ;
|
||||
|
||||
: restore-tortoise ( -- )
|
||||
tortoise-stack> pop >self
|
||||
color> set-color
|
||||
thickness> set-thickness ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: default-values
|
||||
VAR: model-values
|
||||
|
||||
: lparser-dialect ( -- )
|
||||
|
||||
[ 1 >len 45 >angle 1 >thickness 2 >color ] >default-values
|
||||
|
||||
H{ { "+" [ angle> turn-left ] }
|
||||
{ "-" [ angle> turn-right ] }
|
||||
{ "&" [ angle> pitch-down ] }
|
||||
{ "^" [ angle> pitch-up ] }
|
||||
{ "<" [ angle> roll-left ] }
|
||||
{ ">" [ angle> roll-right ] }
|
||||
|
||||
{ "|" [ 180.0 rotate-y ] }
|
||||
{ "%" [ 180.0 rotate-z ] }
|
||||
{ "$" [ roll-until-horizontal ] }
|
||||
|
||||
{ "F" [ len> draw-forward ] }
|
||||
{ "Z" [ len> 2 / draw-forward ] }
|
||||
{ "f" [ len> move-forward ] }
|
||||
{ "z" [ len> 2 / move-forward ] }
|
||||
{ "g" [ len> sneak-forward ] }
|
||||
{ "." [ polygon-vertex ] }
|
||||
|
||||
{ "[" [ save-tortoise ] }
|
||||
{ "]" [ restore-tortoise ] }
|
||||
{ "{" [ start-polygon ] }
|
||||
{ "}" [ finish-polygon ] }
|
||||
|
||||
{ "/" [ 1.1 scale-len ] } ! double quote command in lparser
|
||||
{ "'" [ 0.9 scale-len ] }
|
||||
{ ";" [ 1.1 scale-angle ] }
|
||||
{ ":" [ 0.9 scale-angle ] }
|
||||
{ "?" [ 1.4 scale-thickness ] }
|
||||
{ "!" [ 0.7 scale-thickness ] }
|
||||
|
||||
{ "c" [ color> 1 + color-table> length mod set-color ] }
|
||||
|
||||
} >command-table ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
|
||||
USING: kernel generic math arrays
|
||||
math.matrices generic.lib pos ori self turtle ;
|
||||
|
||||
IN: lsys.tortoise
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: tortoise angle len thickness color ;
|
||||
|
||||
: <tortoise> ( -- tortoise )
|
||||
<turtle> tortoise construct-delegate ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: angle> ( -- val ) self> tortoise-angle ;
|
||||
|
||||
: >angle ( val -- ) self> set-tortoise-angle ;
|
||||
|
||||
: len> ( -- val ) self> tortoise-len ;
|
||||
|
||||
: >len ( val -- ) self> set-tortoise-len ;
|
||||
|
||||
: thickness> ( -- val ) self> tortoise-thickness ;
|
||||
|
||||
: >thickness ( val -- ) self> set-tortoise-thickness ;
|
||||
|
||||
: color> ( -- val ) self> tortoise-color ;
|
||||
|
||||
: >color ( val -- ) self> set-tortoise-color ;
|
||||
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1,13 +0,0 @@
|
|||
USING: tools.deploy.config ;
|
||||
V{
|
||||
{ deploy-ui? t }
|
||||
{ deploy-io 1 }
|
||||
{ deploy-reflection 2 }
|
||||
{ deploy-compiler? t }
|
||||
{ deploy-math? t }
|
||||
{ deploy-word-props? t }
|
||||
{ deploy-word-defs? t }
|
||||
{ deploy-c-types? f }
|
||||
{ "stop-after-last-window?" t }
|
||||
{ deploy-name "Lindenmayer System Explorer" }
|
||||
}
|
||||
|
|
@ -1 +0,0 @@
|
|||
demos
|
||||
|
|
@ -1,507 +0,0 @@
|
|||
|
||||
USING: kernel namespaces threads math math.order math.vectors
|
||||
quotations sequences
|
||||
opengl
|
||||
opengl.gl
|
||||
colors
|
||||
ui
|
||||
ui.gestures
|
||||
ui.gadgets
|
||||
ui.gadgets.packs
|
||||
ui.gadgets.labels
|
||||
ui.gadgets.buttons
|
||||
ui.gadgets.lib
|
||||
ui.gadgets.slate
|
||||
ui.gadgets.theme
|
||||
vars rewrite-closures
|
||||
self pos ori turtle opengl.camera
|
||||
lsys.tortoise lsys.tortoise.graphics
|
||||
lsys.strings.rewrite lsys.strings.interpret
|
||||
combinators.short-circuit accessors ;
|
||||
|
||||
! lsys.strings
|
||||
! lsys.strings.rewrite
|
||||
! lsys.strings.interpret
|
||||
|
||||
IN: lsys.ui
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: slate
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: camera
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
VAR: model
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: display ( -- )
|
||||
|
||||
black set-clear-color GL_COLOR_BUFFER_BIT glClear
|
||||
|
||||
GL_FLAT glShadeModel
|
||||
|
||||
GL_PROJECTION glMatrixMode
|
||||
glLoadIdentity
|
||||
-1 1 -1 1 1.5 200 glFrustum
|
||||
|
||||
GL_MODELVIEW glMatrixMode
|
||||
|
||||
glLoadIdentity
|
||||
|
||||
camera> do-look-at
|
||||
|
||||
GL_FRONT_AND_BACK GL_LINE glPolygonMode
|
||||
|
||||
white color>raw glColor4d
|
||||
|
||||
! white set-color
|
||||
|
||||
GL_LINES glBegin { 0 0 0 } gl-vertex { 0 0 1 } gl-vertex glEnd
|
||||
|
||||
color> set-color
|
||||
|
||||
model> glCallList ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: result>model ( -- )
|
||||
slate> find-gl-context
|
||||
model> GL_COMPILE glNewList result> interpret glEndList ;
|
||||
|
||||
: build-model ( -- )
|
||||
tortoise-stack> delete-all
|
||||
vertices> delete-all
|
||||
reset-turtle
|
||||
default-values> call
|
||||
model-values> call
|
||||
result>model
|
||||
[ display ] closed-quot slate> set-slate-action
|
||||
slate> relayout-1 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
USING: hashtables namespaces.lib ui.gadgets.handler ;
|
||||
|
||||
: camera-action ( quot -- quot )
|
||||
[ drop [ ] camera> with-self slate> relayout-1 ] make* closed-quot ;
|
||||
|
||||
VAR: frame
|
||||
VAR: handler
|
||||
|
||||
DEFER: model-chooser
|
||||
DEFER: scene-chooser
|
||||
DEFER: empty-model
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: lsys-controller ( -- )
|
||||
|
||||
<pile>
|
||||
|
||||
{
|
||||
|
||||
[ "Load" <label> reverse-video-theme ]
|
||||
|
||||
[ "Models" <label> [ drop model-chooser ] closed-quot <bevel-button> ]
|
||||
[ "Scenes" <label> [ drop scene-chooser ] closed-quot <bevel-button> ]
|
||||
|
||||
[ "Model" <label> reverse-video-theme ]
|
||||
|
||||
[ "Iterate" <label> [ drop iterate build-model ] closed-quot <bevel-button> ]
|
||||
[ "Build model" <label> [ drop build-model ] closed-quot <bevel-button> ]
|
||||
|
||||
[ "Camera" <label> reverse-video-theme ]
|
||||
|
||||
[ "Turn left" <label> [ 5 turn-left ] camera-action <bevel-button> ]
|
||||
[ "Turn right" <label> [ 5 turn-right ] camera-action <bevel-button> ]
|
||||
[ "Pitch down" <label> [ 5 pitch-down ] camera-action <bevel-button> ]
|
||||
[ "Pitch up" <label> [ 5 pitch-up ] camera-action <bevel-button> ]
|
||||
|
||||
[ "Forward - a" <label> [ 1 step-turtle ] camera-action <bevel-button> ]
|
||||
[ "Backward - z" <label> [ -1 step-turtle ] camera-action <bevel-button> ]
|
||||
|
||||
[ "Roll left - q" <label> [ 5 roll-left ] camera-action <bevel-button> ]
|
||||
[ "Roll right - w" <label> [ 5 roll-right ] camera-action <bevel-button> ]
|
||||
|
||||
[ "Strafe left - (alt)" <label> [ 1 strafe-left ] camera-action <bevel-button> ]
|
||||
[ "Strafe right - (alt)" <label> [ 1 strafe-right ] camera-action <bevel-button> ]
|
||||
[ "Strafe down - (alt)" <label> [ 1 strafe-up ] camera-action <bevel-button> ]
|
||||
[ "Strafe up - (alt)" <label> [ 1 strafe-down ] camera-action <bevel-button> ]
|
||||
|
||||
[ "View 1 - 1" <label>
|
||||
[ pos> norm reset-turtle 90 turn-left step-turtle 180 turn-left ]
|
||||
camera-action <bevel-button> ]
|
||||
|
||||
[ "View 2 - 2" <label>
|
||||
[ pos> norm reset-turtle 90 pitch-up step-turtle 180 pitch-down ]
|
||||
camera-action <bevel-button> ]
|
||||
|
||||
[ "View 3 - 3" <label>
|
||||
[ pos> norm reset-turtle step-turtle 180 turn-left ]
|
||||
camera-action <bevel-button> ]
|
||||
|
||||
[ "View 4 - 4" <label>
|
||||
[ pos> norm reset-turtle 45 turn-left 45 pitch-up step-turtle 180 turn-left ]
|
||||
camera-action <bevel-button> ]
|
||||
|
||||
}
|
||||
|
||||
[ call add-gadget ] each
|
||||
1 >>fill
|
||||
"L-system control" open-window ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: lsys-viewer ( -- )
|
||||
|
||||
[ ] <slate> >slate
|
||||
{ 400 400 } clone slate> set-slate-pdim
|
||||
|
||||
slate> <handler>
|
||||
|
||||
{
|
||||
|
||||
{ T{ key-down f f "LEFT" } [ [ 5 turn-left ] camera-action ] }
|
||||
{ T{ key-down f f "RIGHT" } [ [ 5 turn-right ] camera-action ] }
|
||||
{ T{ key-down f f "UP" } [ [ 5 pitch-down ] camera-action ] }
|
||||
{ T{ key-down f f "DOWN" } [ [ 5 pitch-up ] camera-action ] }
|
||||
|
||||
{ T{ key-down f f "a" } [ [ 1 step-turtle ] camera-action ] }
|
||||
{ T{ key-down f f "z" } [ [ -1 step-turtle ] camera-action ] }
|
||||
|
||||
{ T{ key-down f f "q" } [ [ 5 roll-left ] camera-action ] }
|
||||
{ T{ key-down f f "w" } [ [ 5 roll-right ] camera-action ] }
|
||||
|
||||
{ T{ key-down f { A+ } "LEFT" } [ [ 1 strafe-left ] camera-action ] }
|
||||
{ T{ key-down f { A+ } "RIGHT" } [ [ 1 strafe-right ] camera-action ] }
|
||||
{ T{ key-down f { A+ } "UP" } [ [ 1 strafe-up ] camera-action ] }
|
||||
{ T{ key-down f { A+ } "DOWN" } [ [ 1 strafe-down ] camera-action ] }
|
||||
|
||||
{ T{ key-down f f "1" }
|
||||
[ [ pos> norm reset-turtle 90 turn-left step-turtle 180 turn-left ]
|
||||
camera-action ] }
|
||||
|
||||
{ T{ key-down f f "2" }
|
||||
[ [ pos> norm reset-turtle 90 pitch-up step-turtle 180 pitch-down ]
|
||||
camera-action ] }
|
||||
|
||||
{ T{ key-down f f "3" }
|
||||
[ [ pos> norm reset-turtle step-turtle 180 turn-left ]
|
||||
camera-action ] }
|
||||
|
||||
{ T{ key-down f f "4" }
|
||||
[ [ pos> norm reset-turtle 45 turn-left 45 pitch-up step-turtle 180 turn-left ]
|
||||
camera-action ] }
|
||||
|
||||
} [ make* ] map >hashtable >>table
|
||||
|
||||
"L-system view" open-window
|
||||
|
||||
500 sleep
|
||||
|
||||
slate> find-gl-context
|
||||
1 glGenLists >model
|
||||
|
||||
<turtle> >camera
|
||||
|
||||
[ camera> >self
|
||||
reset-turtle 45 turn-left 45 pitch-up 5 step-turtle 180 turn-left
|
||||
] with-scope
|
||||
|
||||
init-color-table
|
||||
|
||||
<tortoise> >self
|
||||
|
||||
V{ } clone >tortoise-stack
|
||||
|
||||
V{ } clone >vertices
|
||||
|
||||
empty-model
|
||||
|
||||
build-model
|
||||
|
||||
;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! Examples
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: koch ( -- ) lparser-dialect [ 90 >angle ] >model-values
|
||||
|
||||
H{ { "K" "[[a|b] '(0.41)f'(2.439) |<(60) [a|b]]" }
|
||||
{ "k" "[ c'(0.5) K]" }
|
||||
{ "a" "[d <(120) d <(120) d ]" }
|
||||
{ "b" "e" }
|
||||
{ "e" "[^ '(.2887)f'(3.4758) &(180) +z{.-(120)f-(120)f}]" }
|
||||
{ "d" "[^ '(.2887)f'(3.4758) &(109.5111) +zk{.-(120)f-(120)f}]" }
|
||||
} >rules
|
||||
|
||||
"K" >result ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: spiral-0 ( -- ) lparser-dialect [ 10 >angle 5 >thickness ] >model-values
|
||||
|
||||
"[P]|[P]" >result
|
||||
|
||||
H{ { "P" "[A]>>>>>>>>>[cB]>>>>>>>>>[ccC]>>>>>>>>>[cccD]" }
|
||||
{ "A" "F+;'A" }
|
||||
{ "B" "F!+F+;'B" }
|
||||
{ "C" "F!^+F^+;'C" }
|
||||
{ "D" "F!>^+F>^+;'D" }
|
||||
} >rules ;
|
||||
|
||||
: spiral-0-scene ( -- )
|
||||
spiral-0
|
||||
22 iterations
|
||||
build-model
|
||||
[ reset-turtle 90 turn-left 16 step-turtle 180 turn-left ]
|
||||
camera> with-self slate> relayout-1 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: tree-5 ( -- ) lparser-dialect [ 5 >angle 1 >thickness ] >model-values
|
||||
|
||||
"c(4)FFS" >result
|
||||
|
||||
H{ { "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 ;
|
||||
|
||||
: tree-5-scene ( -- )
|
||||
tree-5
|
||||
9 iterations
|
||||
build-model
|
||||
[ reset-turtle 90 pitch-down -70 step-turtle 50 strafe-up ] camera> with-self
|
||||
slate> relayout-1 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-1 ( -- ) lparser-dialect [ 45 >angle 5 >thickness ] >model-values
|
||||
|
||||
H{ { "A" "F[&'(.8)!BL]>(137)'!(.9)A" }
|
||||
{ "B" "F[-'(.8)!(.9)$CL]'!(.9)C" }
|
||||
{ "C" "F[+'(.8)!(.9)$BL]'!(.9)B" }
|
||||
|
||||
{ "L" "~c(8){+(30)f-(120)f-(120)f}" }
|
||||
} >rules
|
||||
|
||||
"c(12)FFAL" >result ;
|
||||
|
||||
: abop-1-scene ( -- )
|
||||
abop-1
|
||||
8 iterations
|
||||
build-model
|
||||
[ reset-turtle
|
||||
90 pitch-up 7 step-turtle 90 pitch-down 4 step-turtle 90 pitch-down ]
|
||||
camera> with-self slate> relayout-1 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-2 ( -- ) lparser-dialect [ 30 >angle 5 >thickness ] >model-values
|
||||
|
||||
H{ { "A" "F[&'(.7)!BL]>(137)[&'(.6)!BL]>(137)'(.9)!(.9)A" }
|
||||
{ "B" "F[-'(.7)!(.9)$CL]'(.9)!(.9)C" }
|
||||
{ "C" "F[+'(.7)!(.9)$BL]'(.9)!(.9)B" }
|
||||
|
||||
{ "L" "~c(8){+(45)f(.1)-(45)f(.1)-(45)f(.1)+(45)|+(45)f(.1)-(45)f(.1)-(45)f(.1)}" }
|
||||
|
||||
} >rules
|
||||
|
||||
"c(12)FAL" >result ;
|
||||
|
||||
: abop-2-scene ( -- )
|
||||
abop-2
|
||||
7 iterations
|
||||
build-model
|
||||
[ reset-turtle { 0 4 4 } >pos 90 pitch-down ]
|
||||
camera> with-self slate> relayout-1 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-3 ( -- ) lparser-dialect [ 30 >angle 5 >thickness ] >model-values
|
||||
|
||||
H{ { "A" "!(.9)t(.4)FB>(94)B>(132)B" }
|
||||
{ "B" "[&t(.4)F$A]" }
|
||||
{ "F" "'(1.25)F'(.8)" }
|
||||
} >rules
|
||||
|
||||
"c(12)FA" >result ;
|
||||
|
||||
: abop-3-scene ( -- )
|
||||
abop-3 11 iterations build-model
|
||||
[ reset-turtle { 0 47 29 } >pos 90 pitch-down ] camera> with-self
|
||||
slate> relayout-1 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-4 ( -- ) lparser-dialect [ 18 >angle 5 >thickness ] >model-values
|
||||
|
||||
H{ { "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
|
||||
|
||||
"c(12)&(20)N" >result ;
|
||||
|
||||
: abop-4-scene ( -- )
|
||||
abop-4 21 iterations build-model
|
||||
[ reset-turtle
|
||||
{ 53 25 36 } >pos
|
||||
{ { 0.57 -0.14 -0.80 } { -0.81 -0.18 -0.54 } { -0.07 0.97 -0.22 } }
|
||||
>ori
|
||||
] camera> with-self slate> relayout-1 ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-5 ( -- ) lparser-dialect [ 5 >angle 5 >thickness ] >model-values
|
||||
|
||||
H{ { "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
|
||||
|
||||
"&(90)+(90)a" >result ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: abop-6 ( -- ) lparser-dialect [ 5 >angle 5 >thickness ] >model-values
|
||||
|
||||
"&(90)+(90)FFF[-(120)'(.6)x][-(60)'(.8)x][+(120)'(.6)x][+(60)'(.8)x]x" >result
|
||||
|
||||
H{ { "a" "F[cdx][cex]F!(.9)a" }
|
||||
{ "x" "a" }
|
||||
|
||||
{ "d" "+d" }
|
||||
{ "e" "-e" }
|
||||
|
||||
{ "F" "'(1.25)F'(.8)" }
|
||||
} >rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: airhorse ( -- ) lparser-dialect [ 10 >angle 5 >thickness ] >model-values
|
||||
|
||||
"C" >result
|
||||
|
||||
H{ { "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][>>>!!cb]]" }
|
||||
{ "b" "Fl!+Fl+;'b" }
|
||||
{ "l" "[-cc{--z++z++z--|--z++z++z}]" }
|
||||
} >rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: empty-model ( -- )
|
||||
lparser-dialect
|
||||
[ ] >model-values
|
||||
" " >result
|
||||
H{ } >rules ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: model-chooser ( -- )
|
||||
<pile>
|
||||
{
|
||||
[ "abop-1" <label> [ drop abop-1 build-model ] closed-quot <bevel-button> ]
|
||||
[ "abop-2" <label> [ drop abop-2 build-model ] closed-quot <bevel-button> ]
|
||||
[ "abop-3" <label> [ drop abop-3 build-model ] closed-quot <bevel-button> ]
|
||||
[ "abop-4" <label> [ drop abop-4 build-model ] closed-quot <bevel-button> ]
|
||||
[ "abop-5" <label> [ drop abop-5 build-model ] closed-quot <bevel-button> ]
|
||||
[ "abop-6" <label> [ drop abop-6 build-model ] closed-quot <bevel-button> ]
|
||||
[ "tree-5" <label> [ drop tree-5 build-model ] closed-quot <bevel-button> ]
|
||||
[ "airhorse" <label> [ drop airhorse build-model ] closed-quot <bevel-button> ]
|
||||
[ "spiral-0" <label> [ drop spiral-0 build-model ] closed-quot <bevel-button> ]
|
||||
[ "koch" <label> [ drop koch build-model ] closed-quot <bevel-button> ]
|
||||
}
|
||||
[ call add-gadget ] each
|
||||
1 >>fill
|
||||
"L-system models" open-window ;
|
||||
|
||||
: scene-chooser ( -- )
|
||||
<pile>
|
||||
{
|
||||
[ "abop-1" <label> [ drop abop-1-scene ] closed-quot <bevel-button> ]
|
||||
[ "abop-2" <label> [ drop abop-2-scene ] closed-quot <bevel-button> ]
|
||||
[ "tree-5" <label> [ drop tree-5-scene ] closed-quot <bevel-button> ]
|
||||
}
|
||||
[ call add-gadget ] each
|
||||
1 >>fill
|
||||
"L-system scenes" open-window ;
|
||||
|
||||
: lsys-window* ( -- )
|
||||
[ lsys-controller lsys-viewer ] with-ui ;
|
||||
|
||||
MAIN: lsys-window*
|
||||
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
||||
|
|
@ -1,47 +0,0 @@
|
|||
|
||||
USING: kernel math arrays math.vectors math.matrices generic.lib pos ori ;
|
||||
|
||||
IN: turtle
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
TUPLE: turtle ;
|
||||
|
||||
: <turtle> ( -- turtle )
|
||||
turtle new
|
||||
{ 0 0 0 } clone <pos>
|
||||
3 identity-matrix <ori>
|
||||
rot
|
||||
3array chain ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: reset-turtle ( -- ) { 0 0 0 } >pos 3 identity-matrix >ori ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: step-vector ( length -- array ) { 0 0 1 } n*v ;
|
||||
|
||||
: step-turtle ( length -- ) step-vector ori> swap m.v pos> v+ >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 ;
|
||||
|
|
@ -1,4 +1,3 @@
|
|||
WINDRES=windres
|
||||
include vm/Config.windows.nt
|
||||
include vm/Config.x86.32
|
||||
#error "lolllll"
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
#WIN64_PATH=/k/MinGW/win64/bin
|
||||
#WIN64_PATH=/cygdrive/k/MinGW/win64/bin/x86_64-pc-mingw32
|
||||
CC=$(WIN64_PATH)-gcc.exe
|
||||
WINDRES=$(WIN64_PATH)-windres.exe
|
||||
include vm/Config.windows.nt
|
||||
|
|
|
|||
|
|
@ -456,7 +456,7 @@ void factorbug(void)
|
|||
else if(strcmp(cmd,"x") == 0)
|
||||
exit(1);
|
||||
else if(strcmp(cmd,"im") == 0)
|
||||
save_image(STR_FORMAT("fep.image"));
|
||||
save_image(STRING_LITERAL("fep.image"));
|
||||
else if(strcmp(cmd,"data") == 0)
|
||||
dump_objects(-1);
|
||||
else if(strcmp(cmd,"refs") == 0)
|
||||
|
|
|
|||
134
vm/factor.c
134
vm/factor.c
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
void default_parameters(F_PARAMETERS *p)
|
||||
{
|
||||
p->image = NULL;
|
||||
p->image_path = NULL;
|
||||
|
||||
/* We make a wild guess here that if we're running on ARM, we don't
|
||||
have a lot of memory. */
|
||||
|
|
@ -38,6 +38,41 @@ void default_parameters(F_PARAMETERS *p)
|
|||
p->stack_traces = true;
|
||||
}
|
||||
|
||||
INLINE bool factor_arg(const F_CHAR* str, const F_CHAR* arg, CELL* value)
|
||||
{
|
||||
int val;
|
||||
if(SSCANF(str,arg,&val) > 0)
|
||||
{
|
||||
*value = val;
|
||||
return true;
|
||||
}
|
||||
else
|
||||
return false;
|
||||
}
|
||||
|
||||
void init_parameters_from_args(F_PARAMETERS *p, int argc, F_CHAR **argv)
|
||||
{
|
||||
default_parameters(p);
|
||||
|
||||
int i;
|
||||
|
||||
for(i = 1; i < argc; i++)
|
||||
{
|
||||
if(factor_arg(argv[i],STRING_LITERAL("-datastack=%d"),&p->ds_size));
|
||||
else if(factor_arg(argv[i],STRING_LITERAL("-retainstack=%d"),&p->rs_size));
|
||||
else if(factor_arg(argv[i],STRING_LITERAL("-generations=%d"),&p->gen_count));
|
||||
else if(factor_arg(argv[i],STRING_LITERAL("-young=%d"),&p->young_size));
|
||||
else if(factor_arg(argv[i],STRING_LITERAL("-aging=%d"),&p->aging_size));
|
||||
else if(factor_arg(argv[i],STRING_LITERAL("-tenured=%d"),&p->tenured_size));
|
||||
else if(factor_arg(argv[i],STRING_LITERAL("-codeheap=%d"),&p->code_size));
|
||||
else if(STRCMP(argv[i],STRING_LITERAL("-securegc")) == 0) p->secure_gc = true;
|
||||
else if(STRCMP(argv[i],STRING_LITERAL("-fep")) == 0) p->fep = true;
|
||||
else if(STRNCMP(argv[i],STRING_LITERAL("-i="),3) == 0) p->image_path = argv[i] + 3;
|
||||
else if(STRCMP(argv[i],STRING_LITERAL("-console")) == 0) p->console = true;
|
||||
else if(STRCMP(argv[i],STRING_LITERAL("-no-stack-traces")) == 0) p->stack_traces = false;
|
||||
}
|
||||
}
|
||||
|
||||
/* Do some initialization that we do once only */
|
||||
void do_stage1_init(void)
|
||||
{
|
||||
|
|
@ -51,7 +86,6 @@ void do_stage1_init(void)
|
|||
fflush(stdout);
|
||||
}
|
||||
|
||||
/* Get things started */
|
||||
void init_factor(F_PARAMETERS *p)
|
||||
{
|
||||
/* Kilobytes */
|
||||
|
|
@ -70,8 +104,12 @@ void init_factor(F_PARAMETERS *p)
|
|||
/* OS-specific initialization */
|
||||
early_init();
|
||||
|
||||
if(p->image == NULL)
|
||||
p->image = default_image_path();
|
||||
if(p->image_path == NULL)
|
||||
p->image_path = default_image_path();
|
||||
|
||||
const F_CHAR *executable_path = vm_executable_path();
|
||||
if(executable_path)
|
||||
p->executable_path = executable_path;
|
||||
|
||||
srand(current_micros());
|
||||
init_ffi();
|
||||
|
|
@ -93,6 +131,10 @@ void init_factor(F_PARAMETERS *p)
|
|||
userenv[OS_ENV] = tag_object(from_char_string(FACTOR_OS_STRING));
|
||||
userenv[CELL_SIZE_ENV] = tag_fixnum(sizeof(CELL));
|
||||
userenv[STACK_TRACES_ENV] = tag_boolean(p->stack_traces);
|
||||
userenv[EXECUTABLE_ENV] = (p->executable_path ?
|
||||
tag_object(from_native_string(p->executable_path)) : F);
|
||||
userenv[ARGS_ENV] = F;
|
||||
userenv[EMBEDDED_ENV] = F;
|
||||
|
||||
/* We can GC now */
|
||||
gc_off = false;
|
||||
|
|
@ -101,57 +143,11 @@ void init_factor(F_PARAMETERS *p)
|
|||
do_stage1_init();
|
||||
}
|
||||
|
||||
INLINE bool factor_arg(const F_CHAR* str, const F_CHAR* arg, CELL* value)
|
||||
/* May allocate memory */
|
||||
void pass_args_to_factor(int argc, F_CHAR **argv)
|
||||
{
|
||||
int val;
|
||||
if(SSCANF(str,arg,&val) > 0)
|
||||
{
|
||||
*value = val;
|
||||
return true;
|
||||
}
|
||||
else
|
||||
return false;
|
||||
}
|
||||
|
||||
void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded)
|
||||
{
|
||||
F_PARAMETERS p;
|
||||
default_parameters(&p);
|
||||
|
||||
if(image) p.image = image;
|
||||
|
||||
CELL i;
|
||||
|
||||
posix_argc = argc;
|
||||
posix_argv = safe_malloc(argc * sizeof(F_CHAR*));
|
||||
posix_argv[0] = safe_strdup(argv[0]);
|
||||
|
||||
for(i = 1; i < argc; i++)
|
||||
{
|
||||
posix_argv[i] = safe_strdup(argv[i]);
|
||||
if(factor_arg(argv[i],STR_FORMAT("-datastack=%d"),&p.ds_size));
|
||||
else if(factor_arg(argv[i],STR_FORMAT("-retainstack=%d"),&p.rs_size));
|
||||
else if(factor_arg(argv[i],STR_FORMAT("-generations=%d"),&p.gen_count));
|
||||
else if(factor_arg(argv[i],STR_FORMAT("-young=%d"),&p.young_size));
|
||||
else if(factor_arg(argv[i],STR_FORMAT("-aging=%d"),&p.aging_size));
|
||||
else if(factor_arg(argv[i],STR_FORMAT("-tenured=%d"),&p.tenured_size));
|
||||
else if(factor_arg(argv[i],STR_FORMAT("-codeheap=%d"),&p.code_size));
|
||||
else if(STRCMP(argv[i],STR_FORMAT("-securegc")) == 0)
|
||||
p.secure_gc = true;
|
||||
else if(STRCMP(argv[i],STR_FORMAT("-fep")) == 0)
|
||||
p.fep = true;
|
||||
else if(STRNCMP(argv[i],STR_FORMAT("-i="),3) == 0)
|
||||
p.image = argv[i] + 3;
|
||||
else if(STRCMP(argv[i],STR_FORMAT("-console")) == 0)
|
||||
p.console = true;
|
||||
else if(STRCMP(argv[i],STR_FORMAT("-no-stack-traces")) == 0)
|
||||
p.stack_traces = false;
|
||||
}
|
||||
|
||||
init_factor(&p);
|
||||
nest_stacks();
|
||||
|
||||
F_ARRAY *args = allot_array(ARRAY_TYPE,argc,F);
|
||||
int i;
|
||||
|
||||
for(i = 1; i < argc; i++)
|
||||
{
|
||||
|
|
@ -162,23 +158,31 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
|
|||
}
|
||||
|
||||
userenv[ARGS_ENV] = tag_object(args);
|
||||
}
|
||||
|
||||
const F_CHAR *executable_path = vm_executable_path();
|
||||
if(!executable_path)
|
||||
executable_path = argv[0];
|
||||
|
||||
userenv[EXECUTABLE_ENV] = tag_object(from_native_string(executable_path));
|
||||
userenv[EMBEDDED_ENV] = (embedded ? T : F);
|
||||
|
||||
if(p.fep)
|
||||
factorbug();
|
||||
void start_factor(F_PARAMETERS *p)
|
||||
{
|
||||
if(p->fep) factorbug();
|
||||
|
||||
nest_stacks();
|
||||
c_to_factor_toplevel(userenv[BOOT_ENV]);
|
||||
unnest_stacks();
|
||||
}
|
||||
|
||||
for(i = 0; i < argc; i++)
|
||||
free(posix_argv[i]);
|
||||
free(posix_argv);
|
||||
void start_embedded_factor(F_PARAMETERS *p)
|
||||
{
|
||||
userenv[EMBEDDED_ENV] = T;
|
||||
start_factor(p);
|
||||
}
|
||||
|
||||
void start_standalone_factor(int argc, F_CHAR **argv)
|
||||
{
|
||||
F_PARAMETERS p;
|
||||
default_parameters(&p);
|
||||
init_parameters_from_args(&p,argc,argv);
|
||||
init_factor(&p);
|
||||
pass_args_to_factor(argc,argv);
|
||||
start_factor(&p);
|
||||
}
|
||||
|
||||
char *factor_eval_string(char *string)
|
||||
|
|
|
|||
|
|
@ -1,7 +1,10 @@
|
|||
int posix_argc;
|
||||
F_CHAR **posix_argv;
|
||||
DLLEXPORT void default_parameters(F_PARAMETERS *p);
|
||||
DLLEXPORT void init_parameters_from_args(F_PARAMETERS *p, int argc, F_CHAR **argv);
|
||||
DLLEXPORT void init_factor(F_PARAMETERS *p);
|
||||
DLLEXPORT void pass_args_to_factor(int argc, F_CHAR **argv);
|
||||
DLLEXPORT void start_embedded_factor(F_PARAMETERS *p);
|
||||
DLLEXPORT void start_standalone_factor(int argc, F_CHAR **argv);
|
||||
|
||||
DLLEXPORT void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded);
|
||||
DLLEXPORT char *factor_eval_string(char *string);
|
||||
DLLEXPORT void factor_eval_free(char *result);
|
||||
DLLEXPORT void factor_yield(void);
|
||||
|
|
|
|||
|
|
@ -75,10 +75,10 @@ INLINE void load_code_heap(FILE *file, F_HEADER *h, F_PARAMETERS *p)
|
|||
/* This function also initializes the data and code heaps */
|
||||
void load_image(F_PARAMETERS *p)
|
||||
{
|
||||
FILE *file = OPEN_READ(p->image);
|
||||
FILE *file = OPEN_READ(p->image_path);
|
||||
if(file == NULL)
|
||||
{
|
||||
print_string("Cannot open image file: "); print_native_string(p->image); nl();
|
||||
print_string("Cannot open image file: "); print_native_string(p->image_path); nl();
|
||||
print_string(strerror(errno)); nl();
|
||||
exit(1);
|
||||
}
|
||||
|
|
@ -103,7 +103,7 @@ void load_image(F_PARAMETERS *p)
|
|||
relocate_code();
|
||||
|
||||
/* Store image path name */
|
||||
userenv[IMAGE_ENV] = tag_object(from_native_string(p->image));
|
||||
userenv[IMAGE_ENV] = tag_object(from_native_string(p->image_path));
|
||||
}
|
||||
|
||||
/* Save the current image to disk */
|
||||
|
|
|
|||
|
|
@ -26,7 +26,8 @@ typedef struct {
|
|||
} F_HEADER;
|
||||
|
||||
typedef struct {
|
||||
const F_CHAR* image;
|
||||
const F_CHAR *image_path;
|
||||
const F_CHAR *executable_path;
|
||||
CELL ds_size, rs_size;
|
||||
CELL gen_count, young_size, aging_size, tenured_size;
|
||||
CELL code_size;
|
||||
|
|
|
|||
|
|
@ -2,6 +2,6 @@
|
|||
|
||||
int main(int argc, char **argv)
|
||||
{
|
||||
init_factor_from_args(NULL,argc,argv,false);
|
||||
start_standalone_factor(argc,argv);
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
#include <windows.h>
|
||||
#include <stdio.h>
|
||||
#include "master.h"
|
||||
|
||||
/*
|
||||
|
|
@ -8,7 +6,9 @@
|
|||
|
||||
This would not be necessary if Windows CE had CommandLineToArgvW.
|
||||
|
||||
Based on MinGW's public domain char** version. */
|
||||
Based on MinGW's public domain char** version.
|
||||
|
||||
*/
|
||||
|
||||
int __argc;
|
||||
wchar_t **__argv;
|
||||
|
|
@ -128,7 +128,7 @@ WinMain(
|
|||
int nCmdShow)
|
||||
{
|
||||
parse_args(&__argc, &__argv, lpCmdLine);
|
||||
init_factor_from_args(NULL,__argc,(LPWSTR*)__argv,false);
|
||||
start_standalone_factor(__argc,(LPWSTR*)__argv);
|
||||
// memory leak from malloc, wcsdup
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ int WINAPI WinMain(
|
|||
return 1;
|
||||
}
|
||||
|
||||
init_factor_from_args(NULL,nArgs,szArglist,false);
|
||||
init_factor_from_args(nArgs,szArglist);
|
||||
|
||||
LocalFree(szArglist);
|
||||
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ typedef char F_SYMBOL;
|
|||
#define string_to_native_alien(string) string_to_char_alien(string,true)
|
||||
#define unbox_symbol_string unbox_char_string
|
||||
|
||||
#define STR_FORMAT(string) string
|
||||
#define STRING_LITERAL(string) string
|
||||
|
||||
#define SSCANF sscanf
|
||||
#define STRCMP strcmp
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ typedef wchar_t F_CHAR;
|
|||
#define unbox_native_string unbox_u16_string
|
||||
#define string_to_native_alien(string) string_to_u16_alien(string,true)
|
||||
|
||||
#define STR_FORMAT(string) L##string
|
||||
#define STRING_LITERAL(string) L##string
|
||||
|
||||
#define MAX_UNICODE_PATH 32768
|
||||
#define DLLEXPORT __declspec(dllexport)
|
||||
|
|
@ -20,20 +20,18 @@ typedef wchar_t F_CHAR;
|
|||
#define STRNCMP wcsncmp
|
||||
#define STRDUP _wcsdup
|
||||
|
||||
|
||||
#ifdef WIN64
|
||||
#define CELL_FORMAT "%Iu"
|
||||
#define CELL_HEX_FORMAT "%Ix"
|
||||
#define CELL_HEX_FORMAT "%Ix"
|
||||
#define CELL_HEX_PAD_FORMAT "%016Ix"
|
||||
#define FIXNUM_FORMAT "%Id"
|
||||
#define FIXNUM_FORMAT "%Id"
|
||||
#else
|
||||
#define CELL_FORMAT "%lu"
|
||||
#define CELL_HEX_FORMAT "%lx"
|
||||
#define CELL_HEX_FORMAT "%lx"
|
||||
#define CELL_HEX_PAD_FORMAT "%08lx"
|
||||
#define FIXNUM_FORMAT "%ld"
|
||||
#define FIXNUM_FORMAT "%ld"
|
||||
#endif
|
||||
|
||||
|
||||
#define OPEN_READ(path) _wfopen(path,L"rb")
|
||||
#define OPEN_WRITE(path) _wfopen(path,L"wb")
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue